home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Taifun / Taifun 013 (1987-05-15)(Ossowski, Stefan)(DE)(PD).zip / Taifun 013 (1987-05-15)(Ossowski, Stefan)(DE)(PD).adf / amigaventure / AmigaVenture.bas < prev    next >
BASIC Source File  |  1987-03-04  |  102KB  |  3,524 lines

  1. DEFINT a-z
  2. game$ = "AmigaVenture 1.17" ' Version number of game
  3. dataformat$ = "AmigaVenture 1.1X" ' Version number for load/save only
  4. '
  5. '  AmigaVenture Kernal 1.17
  6. '
  7. '  Core routines for writing an Adventure of your own
  8. '  In Microsoft AmigaBasic
  9. '
  10. '  by Mitsu Hadeishi 7/15/86
  11. '  1460 W. 182nd Street
  12. '  Gardena CA 90248
  13. '
  14. '  Written for the Winner's Circle Amiga User's Group
  15. '
  16. '---------------------------------------------------------------------------
  17. '  Permission is given to freely distribute this code in full or in part
  18. '  provided this notice is copied IN FULL.
  19. '
  20. '  AmigaVenture Kernal Copyright (c) 1986 by Mitsu Hadeishi
  21. '  This code may not be used in part or in full in any commercial
  22. '  product, nor may this code in part or in full be sold intentionally
  23. '  to make a profit, without an explicit written agreement with the author.
  24. '---------------------------------------------------------------------------
  25. '
  26. '  Please write to me if you have plans to distribute a significantly
  27. '  modified version of the *kernal*.
  28. '  Feel free to distribute *adventures* written with this kernal without
  29. '  contacting me, but please! give credit where credit is due.
  30. '
  31. '  Updates and enhancements may be obtained from:
  32. '
  33. '  Mitsu Hadeishi
  34. '  hadeishi@husc4.UUCP
  35. '  or hadeishi%husc4.harvard.edu
  36. '  3 Sacramento Street
  37. '  Cambridge, MA 02138
  38. '
  39. '  All variables are, unless otherwise indicated, short integers.
  40. '
  41. GOTO Initialize
  42.  
  43. Messages:
  44. ' Message subroutines/subprograms
  45. Cannot:
  46. IF n$(1) = "" THEN
  47.    PRINT"You can't "v$" "nn$(0)"!
  48. ELSE
  49.    PRINT"You can't "v$" "nn$(0)" "p$" "nn$(1)"!
  50. END IF
  51. RETURN
  52.  
  53. SUB CantSee(nn$) STATIC
  54. PRINT"I don't see what you're referring to.
  55. END SUB
  56.  
  57. SUB DontHave(nn$) STATIC
  58. PRINT"You don't have "nn$"!
  59. END SUB
  60.  
  61. SUB CantGetAt(nn$) STATIC
  62. PRINT"You can't get at "nn$"!"
  63. END SUB
  64.  
  65. Absurd:
  66. ON RND(1)*2+1 GOTO Absurd1,Absurd2
  67. Absurd1:
  68. PRINT"Don't be absurd.":RETURN
  69. Absurd2:
  70. PRINT"Don't talk nonsense.":RETURN
  71.  
  72. Mystery:
  73. PRINT"I can't see what you're referring to.
  74. RETURN
  75.  
  76. ' Prints a list of alternatives for the player to select from
  77. ' If all the choices are positionally referenced, then "that" is
  78. ' returned as 1
  79. SUB AskAmbig(choice(2),num,that) STATIC
  80. SHARED adj$(),par(),rel(),prepn$()
  81.  
  82. PRINT"Which do you mean:"
  83. num = ABS(num)
  84. FOR i = 1 TO num
  85.    IF i = num THEN PRINT"or ";
  86.    c=choice(i,0)
  87.    CALL NameNoun(c,n$,nn$)
  88.    IF c > 0 AND adj$(c) <> "" THEN
  89.       PRINT"the "adj$(c)" "n$;
  90.       that=-1
  91.    ELSE
  92.       PRINT nn$;
  93.    END IF
  94.    IF c > 0 AND adj$(c) = "" AND par(c) <> 0 THEN
  95.       PRINT" that's "prepn$(rel(c)+1)" ";
  96.       IF that <> -1 THEN that=1
  97.       CALL NameNoun(par(c),n$,nn$)
  98.       PRINT nn$;
  99.    END IF
  100.    IF i = num THEN PRINT"?" ELSE PRINT", ";
  101. NEXT i
  102. IF that = -1 THEN that=0
  103. END SUB
  104.  
  105. Calc:
  106. '
  107. ' Calculation subprograms follow
  108. '
  109.  
  110. ' Visible() determines whether noun code 'code' is visible or not.
  111. ' If type is 1, then only checks to see if visible on the player,
  112. ' if 2, then only checks to see if visible in room (but not on player).
  113. ' Returns truth value in vis
  114. SUB Visible(code,vis,type) STATIC
  115. SHARED par(),rel(),opaque(),closed(),lo(),l
  116.  
  117. a = type
  118.  
  119. obj = code
  120.  
  121. IF obj < 0 THEN vis=1:EXIT SUB
  122.  
  123. vis = 0
  124. IF a = 1 THEN IF lo(obj) <> 1 THEN EXIT SUB
  125. IF a = 2 THEN IF lo(obj) <> l THEN EXIT SUB
  126. IF a = 0 THEN IF lo(obj) <> 1 AND lo(obj) <> l THEN EXIT SUB
  127.  
  128. vis = -1
  129. WHILE (vis = -1)
  130.    IF par(obj) < 2 THEN
  131.       vis = 1
  132.    ELSEIF (opaque(rel(obj),par(obj)) = 1) AND (rel(obj) = 0 AND closed(par(obj)) <> 0) THEN
  133.       vis = 0
  134.    ELSE
  135.       obj = par(obj)
  136.    END IF
  137. WEND
  138. END SUB
  139.  
  140. ' Avail() determines whether noun code 'code' is available or not.
  141. ' If the object is available, but you couldn't get it out from where
  142. ' it is, returns -1
  143. ' See Visible, above, for explanation of 'type'
  144. ' Returns truth value in ava
  145. SUB Avail(code,ava,type) STATIC
  146. SHARED par(),rel(),closed(),lo(),l,opening(),size(),holdwater()
  147.  
  148. a = type
  149. IF a = 0 THEN a = 3
  150. obj = code
  151.  
  152. IF obj < 0 THEN ava=1:EXIT SUB
  153.  
  154. ava = 0
  155. IF a = 1 THEN IF lo(obj) <> 1 THEN EXIT SUB
  156. IF a = 2 THEN IF lo(obj) <> l THEN EXIT SUB
  157. IF a = 0 THEN IF lo(obj) <> 1 AND lo(obj) <> l THEN EXIT SUB
  158.  
  159. siz = size(code):IF holdwater(code) = 2 THEN siz = 0
  160.  
  161. WHILE (1)
  162.    IF par(obj)<2 THEN
  163.       IF ava <> -1 THEN ava = 1
  164.       EXIT SUB
  165.    ELSEIF closed(par(obj)) <> 0 AND (rel(obj) < 2) THEN
  166.       ava = 0
  167.       EXIT SUB
  168.    ELSEIF opening(rel(obj),par(obj)) < siz THEN
  169.       ava = -1
  170.    END IF
  171.    obj = par(obj)
  172. WEND
  173. END SUB
  174.  
  175. '*** CheckLight() should be modified for your own program's way
  176. '*** of casting light and shadow on the situation.  Returns 0
  177. '*** for total darkness, 1 for lamp light, 2 for moonlight/nighttime,
  178. '*** 3 for twilight, 4 for daylight
  179. SUB CheckLight(light) STATIC
  180. SHARED l,lamp,lampon,day,flag(),Llight(),Lon()
  181.  
  182. light = 0
  183. IF Lon(l) THEN light = Lon(l):EXIT SUB
  184. IF Llight(l) = 1 AND flag(day) <> 0 THEN light = flag(day):EXIT SUB
  185.  
  186. CALL Visible(lamp,vis,0)
  187. IF (flag(lampon) = 1) AND (vis = 1) THEN light = 1
  188. END SUB
  189.  
  190. ' NameNoun() returns appropriate strings in n$ and nn$, where
  191. ' n$ is the class word for the noun code, and nn$ is "the " + n$,
  192. ' unless the noun is abstract (negative code) in which case nn$ = n$
  193. SUB NameNoun(n,n$,nn$) STATIC
  194. SHARED word$(),abstract$()
  195. IF n > 0 THEN
  196.    n$ = word$(n)
  197.    nn$ = "the " + n$
  198. ELSE
  199.    n$ = abstract$(-n)
  200.    nn$ = n$
  201. END IF
  202. END SUB
  203.  
  204. Calc2:
  205. ' Places in array() siblings starting with object obj and children
  206. ' which are underneath all objects in the list.
  207. ' Starts the list at array(count + 1) (this allows you to call this
  208. ' routine multiple times and list several lists)  This routine
  209. ' is used by the interpreter to list objects
  210. SUB ListSib(obj,array(2),count(1),nn) STATIC
  211. SHARED cc(),opaque(),right(),first()
  212.  
  213. ll = 1
  214. cc(1) = obj
  215. cc(0) = 0
  216.  
  217. ListSib1:
  218. WHILE (ll > 0)
  219.    WHILE (cc(ll))
  220.       count(nn) = count(nn) + 1
  221.       array(nn,count(nn)) = cc(ll)
  222.       IF first(3,cc(ll)) <> 0 AND opaque(3,cc(ll)) = 0 THEN
  223.          ll = ll + 1
  224.          cc(ll) = first(3,cc(ll-1))
  225.          GOTO ListSib1
  226.       END IF
  227.       cc(ll) = right(cc(ll))
  228.    WEND
  229.    ll = ll - 1
  230.    cc(ll) = right(cc(ll))
  231. WEND
  232. END SUB
  233.  
  234. ' Determines if c1 is a descendant of c2 (inside, on, etc.)
  235. ' Returns truth value in ins
  236. SUB Inside(c1,c2,ins,rel) STATIC
  237. SHARED par()
  238.  
  239. ins = 0
  240. c = c1
  241. WHILE (c)
  242.    IF par(c) = c2 THEN ins = 1:rel = rel(c):EXIT SUB
  243.    c = par(c)
  244. WEND
  245. END SUB
  246.  
  247. ' EvalCond evaluates a condition on the flag() array; ret is the truth
  248. ' value returned.  The condition tested depends on the value of b;
  249. ' it is whether or not flag(a) < c, flag(a) = c, or flag(a) > c,
  250. ' depending on whether b = -1, 0, or 1, respectively.  This function
  251. ' is used to evaluate the conditionals in the map and the descriptions.
  252. ' (see Go:, Look:, and map:).
  253. SUB EvalCond(a,b,c,ret) STATIC
  254. SHARED flag(),random
  255.  
  256. IF a = random THEN CALL RollDice
  257. IF b = 0 THEN
  258.    ret = (flag(a) = c)
  259. ELSEIF b = 1 THEN
  260.    ret = (flag(a) > c)
  261. ELSE
  262.    ret = (flag(a) < c)
  263. END IF
  264. END SUB
  265.  
  266. SUB RollDice STATIC
  267. SHARED flag(),random
  268.  
  269. flag(random) = RND(1) * 100
  270. END SUB
  271.  
  272. ' List all bottles in the player's possession
  273. ' Starts at array(0), returns count in a
  274. SUB ListBottles(array(1),a) STATIC
  275. SHARED bottles(),lo(),nbot
  276.  
  277. a = 0
  278. FOR i = 0 TO nbot
  279.    IF lo(bottles(i)) = 1 THEN
  280.       CALL Avail(bottles(i),ava,1)
  281.       IF ava THEN
  282.          array(a) = bottles(i)
  283.          a = a + 1
  284.       END IF
  285.    END IF
  286. NEXT
  287. END SUB
  288.  
  289. Lists:
  290. ' The following subprograms handle the linked lists of objects,
  291. ' parents, children, siblings
  292.  
  293. ' Contents() prints a list of obj and all siblings and children
  294. ' If sing = 1, then just prints what's in it,
  295. ' not siblings
  296. SUB Contents(obj,indent,sing) STATIC
  297. SHARED cc(),mc(),mrel,pre$(),word$(),closed(),opaque(),right(),worn()
  298. SHARED folded(),fold$(),first()
  299.  
  300. ll = 1
  301. mc(1) = 0
  302. cc(1) = obj
  303.  
  304. WHILE (ll > 0)
  305.    WHILE (cc(ll) <> 0)
  306. Contents1:
  307.       c = cc(ll)
  308.       mode = mc(ll)
  309.       IF mode = 0 AND (sing = 0 OR ll > 1) AND c > 1 THEN
  310.          PRINT TAB(indent);pre$(c)" "word$(c);
  311.          IF folded(c) THEN
  312.             PRINT" ("fold$(folded(c))")"
  313.          ELSE
  314.             PRINT
  315.          END IF
  316.       END IF
  317.       IF first(mode,c) <> 0 AND (opaque(mode,c) = 0 OR (mode = 0 AND closed(c) = 0)) THEN
  318.          nn$ = "the " + word$(c)
  319.          PRINT TAB(indent);
  320.          IF sing = 2 THEN
  321.             ' *** Don't print anything
  322.          ELSEIF mode = 0 THEN
  323.             IF c = 1 THEN
  324.                PRINT"You are wearing:"
  325.             ELSE
  326.                IF sing THEN PRINT FNcap$(nn$); ELSE PRINT nn$;
  327.                PRINT" contains:"
  328.             END IF
  329.          ELSEIF mode = 1 THEN
  330.             IF c = 1 THEN
  331.                PRINT"You are carrying:"
  332.             ELSE
  333.                IF sing THEN PRINT"W"; ELSE PRINT"w";
  334.                PRINT"rapped by "nn$", you see:"
  335.             END IF
  336.          ELSEIF mode = 2 THEN
  337.             IF sing THEN PRINT"L"; ELSE PRINT"l";
  338.             PRINT"ying on "nn$", you see:"
  339.          ELSEIF mode = 3 THEN
  340.             IF sing THEN PRINT"U"; ELSE PRINT"u";
  341.             PRINT"nder "nn$", you see:"
  342.          END IF
  343.          ll = ll + 1
  344.          cc(ll) = first(mode,c)
  345.          mc(ll) = 0
  346.          indent = indent + 3
  347.          GOTO Contents1
  348.       END IF
  349.       mc(ll) = mc(ll) + 1
  350.       IF mc(ll) > mrel THEN
  351.          IF sing THEN IF ll = 1 THEN EXIT SUB
  352.          cc(ll) = right(c)
  353.          mc(ll) = 0
  354.       END IF
  355.    WEND
  356.    ll = ll - 1
  357.    indent = indent - 3
  358.    mc(ll) = mc(ll) + 1
  359.    IF mc(ll) > mrel THEN
  360.       IF sing THEN IF ll = 1 THEN EXIT SUB
  361.       cc(ll) = right(cc(ll))
  362.       mc(ll) = 0
  363.    END IF
  364. WEND
  365. END SUB
  366.  
  367. ' Removes object from list and places it in limbo
  368. SUB Remove(obj) STATIC
  369. SHARED par(),right(),left(),rel(),first(),last()
  370. SHARED Lfirst(),Llast(),lo(),totw(),totb(),bulk(),size()
  371.  
  372. ri = right(obj)
  373. le = left(obj)
  374. right(le) = ri
  375. left(ri) = le
  376.  
  377. IF par(obj) = 0 THEN
  378.    lc = lo(obj)
  379.    IF Llast(lc) = obj THEN Llast(lc) = le
  380.    IF Lfirst(lc) = obj THEN Lfirst(lc) = ri
  381. ELSE
  382.    pa = par(obj)
  383.    IF last(rel(obj),pa) = obj THEN last(rel(obj),pa) = le
  384.    IF first(rel(obj),pa) = obj THEN first(rel(obj),pa) = ri
  385.    c = obj
  386.    w = totw(c):b = totb(c)
  387.    IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - size(c)
  388.    WHILE (pa)
  389.       IF rel(c) < 3 THEN totw(pa) = totw(pa) - w ELSE w = 0
  390.       IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - b
  391.       IF rel(c) = 1 OR rel(c) = 2 THEN totb(pa) = totb(pa) - b ELSE b = 0
  392.       c = par(c)
  393.       pa = par(c)      
  394.    WEND
  395. END IF
  396.  
  397. par(obj) = 0
  398. left(obj) = 0
  399. right(obj) = 0
  400. lo(obj) = 0
  401. rel(obj) = 0
  402. END SUB
  403.  
  404. ' Inserts object into relation to object "into".  If into is negative
  405. ' or zero, the routine will insert it into the room number -into.
  406. ' The relation is determined by "mode".  This is 0 for in, 1 for wrapped,
  407. ' 2 for on top of, and 3 for underneath (like under a table, NOT like
  408. ' under something stacked on top of the object.)
  409. ' NOTE: this routine assumes that the object has already been "Removed"
  410. ' (see above.)  The routine does not do any checking for weight, capacity,
  411. ' or mode violations.  This must be done by the calling routine, using the
  412. ' totw() and totb() arrays, which are updated by this routine.
  413. SUB Insert(obj,into,mode) STATIC
  414. SHARED par(),rel(),mrel,right(),left(),first(),last()
  415. SHARED Lfirst(),Llast(),lo(),totw(),totb(),bulk(),size()
  416.  
  417. IF mode < 0 OR mode > mrel THEN EXIT SUB
  418.  
  419. right(obj) = 0
  420.  
  421. IF into > 0 THEN
  422.    par(obj) = into
  423.    IF first(mode,into) = 0 THEN first(mode,into) = obj
  424.    left(obj) = last(mode,into)
  425.    right(last(mode,into)) = obj
  426.    last(mode,into) = obj
  427.    rel(obj) = mode
  428.    pa = into
  429.    c = obj
  430.    w = totw(c):b = totb(c)
  431.    IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + size(c)
  432.    WHILE (pa)
  433.       IF rel(c) < 3 THEN totw(pa) = totw(pa) + w ELSE w = 0
  434.       IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + b
  435.       IF rel(c) = 1 OR rel(c) = 2 THEN totb(pa) = totb(pa) + b ELSE b = 0
  436.       c = par(c)
  437.       pa = par(c)
  438.    WEND
  439.    CALL Setloc(obj,lo(into),1)
  440. ELSE
  441.    into = -into
  442.    par(obj) = 0
  443.    rel(obj) = 0
  444.    IF Lfirst(into) = 0 THEN Lfirst(into) = obj
  445.    left(obj) = Llast(into)
  446.    right(Llast(into)) = obj
  447.    Llast(into) = obj
  448.    CALL Setloc(obj,into,1)
  449. END IF
  450. END SUB
  451.  
  452. ' Sets the location of obj and all its descendants recursively
  453. ' If sing is 0, then all siblings are set to location l as well,
  454. ' otherwise, only obj is set
  455. SUB Setloc(obj,l,sing) STATIC
  456. SHARED mrel,cc(),mc(),first(),right(),lo()
  457.  
  458. lo(obj) = l
  459. ll = 1
  460. mc(1) = 0
  461. cc(1) = obj
  462.  
  463. WHILE (ll > 0)
  464.    WHILE (cc(ll) <> 0)
  465. Setloc1:
  466.       c = cc(ll)
  467.       mode = mc(ll)      
  468.       lo(c) = l
  469.       IF (first(mode,c) <> 0) THEN
  470.          ll = ll + 1
  471.          cc(ll) = first(mode,c)
  472.          GOTO Setloc1
  473.       END IF
  474.       mc(ll) = mc(ll) + 1
  475.       IF mc(ll) > mrel THEN
  476.          IF sing THEN IF ll = 1 THEN EXIT SUB
  477.          cc(ll) = right(cc(ll))
  478.          mc(ll) = 0
  479.       END IF
  480.    WEND
  481.    ll = ll - 1
  482.    mc(ll) = mc(ll) + 1
  483.    IF mc(ll) > mrel THEN
  484.       IF sing THEN IF ll = 1 THEN EXIT SUB
  485.       cc(ll) = right(cc(ll))
  486.       mc(ll) = 0
  487.    END IF
  488. WEND
  489. END SUB
  490.  
  491. ' Removes the list of objects related to "code" in the relationship
  492. ' "mode" (0 - in, 1 - wrapped, 2 - on, 3 - underneath).
  493. ' Returns the first object in the list in "head".
  494. ' ***WARNING***:
  495. ' This routine DOES NOT set the location pointers, to speed up routines
  496. ' that set the location pointers themselves.  Therefore the list is
  497. ' unlinked (it won't show up in a "look" or "examine", etc.) but if you
  498. ' ask whether or not the objects are visible or accessibile (with
  499. ' Visible() and Avail()) they will still be "there" in the room.
  500. ' To send them to limbo, call Setloc(head,0,0) after RemList.
  501. SUB RemList(code,mode,head) STATIC
  502. SHARED par(),rel(),right(),first(),last(),Lfirst(),Llast()
  503. SHARED totw(),totb(),bulk(),size()
  504.  
  505. IF code > 0 THEN
  506.    head = first(mode,code)
  507.    first(mode,code) = 0
  508.    last(mode,code) = 0
  509. ELSE
  510.    code = -code
  511.    head = Lfirst(code)
  512.    Lfirst(code) = 0
  513.    Llast(code) = 0
  514. END IF
  515.  
  516. c = head
  517. WHILE (c)
  518.    pa = par(c)
  519.    d = c
  520.    w = totw(c):b = totb(c)
  521.    IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - size(c)
  522.    WHILE (pa)
  523.       IF rel(c) < 3 THEN totw(pa) = totw(pa) - w ELSE w = 0
  524.       IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - b
  525.       IF rel(d) = 1 OR rel(d) = 2 THEN totb(pa) = totb(pa) - b ELSE b = 0
  526.       d = par(d)
  527.       pa = par(d)      
  528.    WEND
  529.    par(c) = 0
  530.    rel(c) = 0
  531.    c = right(c)
  532. WEND
  533. END SUB
  534.  
  535. ' Concat concatenates the list of objects beginning with "head" into
  536. ' relationship with "code" in the manner "mode".  If code is
  537. ' positive, it is an object, if negative, it is a location.
  538. ' This routine typically called after RemList.
  539. SUB Concat(head,code,mode) STATIC
  540. SHARED lo(),par(),rel(),left(),right(),first(),last(),Lfirst(),Llast()
  541. SHARED totw(),totb(),bulk(),size()
  542.  
  543. IF head = 0 THEN EXIT SUB
  544. into = code
  545. IF code <= 0 THEN mode = 0:into = 0
  546. totw = 0:totb = 0
  547. c = head
  548. WHILE (c)
  549.    rel(c) = mode
  550.    par(c) = into
  551.    pa = into
  552.    d = c
  553.    w = totw(c):b = totb(c)
  554.    IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + size(c)
  555.    WHILE (pa)
  556.       IF rel(c) < 3 THEN totw(pa) = totw(pa) + w ELSE w = 0
  557.       IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + b
  558.       IF rel(d) = 1 OR rel(d) = 2 THEN totb(pa) = totb(pa) + b ELSE b = 0
  559.       d = par(d)
  560.       pa = par(d)      
  561.    WEND
  562.    tail = c
  563.    c = right(c)
  564. WEND
  565. IF code > 0 THEN
  566.    left(head) = last(mode,code)
  567.    right(last(mode,code)) = head
  568.    IF first(mode,code) = 0 THEN first(mode,code) = head
  569.    last(mode,code) = tail
  570.    lc = lo(code)
  571. ELSE
  572.    code = -code
  573.    left(head) = Llast(code)
  574.    right(Llast(code)) = head
  575.    IF Lfirst(code) = 0 THEN Lfirst(code) = head
  576.    Llast(code) = tail
  577.    lc = code
  578. END IF
  579. CALL Setloc(head,lc,0)
  580. END SUB
  581.  
  582. WaterLists:
  583. ' Fill() fills the obj with the specified about of water.  Returns
  584. ' the actual amount filled in wat.
  585. SUB Fill(obj,wat) STATIC
  586. SHARED totw(),totb(),bulk(),par(),rel(),cap(),size()
  587.  
  588. IF obj < 0 THEN EXIT SUB
  589. IF wat = 0 THEN EXIT SUB
  590.  
  591. c=obj
  592. IF cap(0,c)=-1 THEN RETURN 'Infinite capacity (river, lake, etc.)
  593. ' Check for overflow/underflow
  594. IF wat + bulk(0,c) > cap(0,c) THEN
  595.    wat = cap(0,c) - bulk(0,c)
  596.    IF wat < 0 THEN wat = 0:EXIT SUB
  597. ELSEIF wat + bulk(0,c) <= 0 THEN
  598.    wat = -bulk(0,c)
  599.    CALL Empty(obj)
  600.    EXIT SUB
  601. END IF
  602.  
  603. c = obj
  604. IF par(c+1) = 0 THEN ' No current water object inside c
  605.    totw(c+1) = wat
  606.    totb(c+1) = wat
  607.    size(c+1) = wat
  608.    CALL Insert(c+1,c,0)
  609.    EXIT SUB
  610. ELSE ' Must modify bulk, weight in c
  611.    totw(c+1) = totw(c+1) + wat
  612.    totb(c+1) = totw(c+1) + wat
  613.    size(c+1) = size(c+1) + wat
  614.    bulk(0,c) = bulk(0,c) + wat
  615.    WHILE (c)
  616.       totw(c) = totw(c) + wat
  617.       IF rel(c) < 3 THEN c = par(c) ELSE c = 0
  618.    WEND
  619. END IF
  620. END SUB
  621.  
  622. ' Empties the water from object "obj".  This routine DOES
  623. ' check to make sure the object IS a container
  624. SUB Empty(obj) STATIC
  625. SHARED holdwater(),par(),cap(),size(),totw(),totb()
  626.  
  627. IF obj < 0 THEN EXIT SUB
  628. IF cap(0,obj)=-1 THEN RETURN 'Infinite capacity (river, lake, etc.)
  629. IF holdwater(obj) <> 1 THEN EXIT SUB
  630. IF par(obj+1) = 0 THEN EXIT SUB
  631. CALL Remove(obj+1)
  632. size(obj+1) = 0
  633. totw(obj+1) = 0
  634. totb(obj+1) = 0
  635. END SUB
  636.  
  637. ' The Tumble routine takes all objects that are stacked on top of
  638. ' the object obj and makes them siblings of obj
  639. SUB Tumble(obj) STATIC
  640. SHARED cc(),c1(),c2(),lo(),par(),first(),right()
  641.  
  642. ll = 1
  643. cc(1) = first(2,obj)
  644. IF cc(1) = 0 THEN EXIT SUB
  645. tum = 0
  646. c1(tum) = obj
  647.  
  648. PRINT c1(tum)
  649. WHILE (ll > 0)
  650.    WHILE (cc(ll) <> 0)
  651. Tumble1:
  652.       c = cc(ll)
  653.       IF (first(2,c) <> 0) THEN
  654.          tum = tum + 1
  655.          c1(tum) = c
  656.          ll = ll + 1
  657.          cc(ll) = first(2,c)
  658.          GOTO Tumble1
  659.       END IF
  660.       cc(ll) = right(cc(ll))
  661.    WEND
  662.    ll = ll - 1
  663.    cc(ll) = right(cc(ll))
  664. WEND
  665. FOR i = 0 TO tum
  666.    CALL RemList(c1(i),2,c2(i))
  667. NEXT i
  668. lc = par(obj)
  669. IF lc = 0 THEN lc = -lo(obj)
  670. FOR i = 0 TO tum
  671.    CALL Concat(c2(i),lc,0)
  672. NEXT i
  673. END SUB
  674.  
  675. '
  676. ' Interpreter subprograms follow
  677. '
  678.  
  679. Interpreter:
  680. ' GetVerb() returns a verb code in v and a verb string in v$,
  681. ' and returns cmd$ starting with the first word following the verb phrase
  682. SUB GetVerb(cmd$,v,v$) STATIC
  683. SHARED verb$()
  684.  
  685. IF cmd$ = "" THEN EXIT SUB
  686. cc(3) = -1
  687. FOR i = 2 TO 0 STEP -1
  688. cc(i) = INSTR(cc(i+1)+2,cmd$," ") - 1
  689. NEXT i
  690.  
  691. FOR i = 0 TO 2 '*** Search 3-word, 2-word, then 1-word verb lists
  692. IF cc(i) < 0 THEN GetVerb1
  693. c$ = "," + LEFT$(cmd$,cc(i)) + ","
  694. c = INSTR(verb$(i),c$)
  695. IF c <> 0 THEN vl = i:i = 2
  696. GetVerb1:
  697. NEXT i
  698.  
  699. IF c = 0 THEN
  700.    EXIT SUB
  701. ELSE
  702.    v$ = MID$(c$,2,LEN(c$) - 2)
  703.    lv = LEN(v$)
  704.    v = VAL(MID$(verb$(vl),c + lv + 2))
  705.    cmd$ = MID$(cmd$,lv + 2)
  706.    WHILE (MID$(cmd$,1,1) = " ")
  707.      cmd$ = MID$(cmd$,2)
  708.    WEND
  709. END IF
  710. END SUB
  711.  
  712. ' ExNoun() returns an array of noun code choices and a count
  713. ' Returns 0 in nch if no noun is found
  714. ' Returns -1 if inconsistent nouns are found (like "diamond sandwich", etc.)
  715. ' Returns 1 in "that" if a "that" clause is identified
  716. ' Note: this routine exits immediately after ambiguity is resolved.
  717. ' This routine truncates cmd$
  718. SUB ExNoun(cmd$,choice(2),nch,that) STATIC
  719. SHARED mhom,nnoun,noun$,nindex(),nhom(),ncode()
  720. ll = 0
  721. ExNoun1:
  722.  
  723. IF cmd$ = "" THEN ExNoun2
  724. c$ = ","+LEFT$(cmd$,INSTR(cmd$," ")-1)+","
  725. c = INSTR(noun$,c$)
  726. IF c = 0 THEN ExNoun2
  727. ln = LEN(c$) - 2
  728. i = VAL(MID$(noun$,c + ln + 2))
  729. cmd$ = MID$(cmd$,ln + 2)
  730. WHILE (MID$(cmd$,1,1) = " ")
  731.   cmd$ = MID$(cmd$,2)
  732. WEND
  733.  
  734. IF ncode(nindex(i)) = -14 THEN that = 1:GOTO ExNoun2 ' Found "that"
  735. IF ncode(nindex(i)) = -15 THEN ' "what's" == "everything that"
  736.    IF nch THEN nch = -1:EXIT SUB
  737.    choice(1,0) = -11:nch = 1:that = 1
  738.    CALL SkipNoun(cmd$)
  739.    EXIT SUB
  740. END IF
  741. IF (nhom(i) = 0) THEN ExNoun1 '*** Null word, get next word
  742. IF (nch = 0) THEN   '*** Empty context
  743.    FOR j = 1 TO nhom(i)   '*** Ambiguous
  744.       code = ncode(nindex(i) + j - 1)
  745.       nch = nch + 1
  746.       choice(nch,ll) = ncode(nindex(i) + nch -1)
  747.    NEXT j
  748.    ll = 1 - ll
  749.    GOTO ExNoun1
  750. ELSE   '*** Try to resolve ambiguity within old context
  751.    newnch = 0
  752.    FOR j = 1 TO nch
  753.       FOR k = 1 TO nhom(i)
  754.          code = ncode(nindex(i)+k-1)
  755.          IF choice(j,1-ll) = code THEN
  756.             newnch = newnch + 1
  757.             choice(newnch,ll) = code
  758.             k = mhom
  759.          END IF
  760.       NEXT k
  761.    NEXT j
  762.    IF newnch = 0 THEN
  763.       nch = -1:REM inconsistent nouns
  764.       EXIT SUB
  765.    END IF
  766.    nch = newnch
  767.    ll = 1 - ll
  768.    GOTO ExNoun1
  769. END IF
  770.  
  771. ExNoun2:
  772. IF ll = 0 THEN
  773.    FOR i = 1 TO nch
  774.       choice(i,0) = choice(i,1)
  775.    NEXT i
  776. END IF
  777.  
  778. END SUB
  779.  
  780. ' Skip noun (skips nouns without looking at meaning)
  781. SUB SkipNoun(cmd$) STATIC
  782. SHARED noun$
  783. ll = 0
  784.  
  785. SkipNoun1:
  786.  
  787. IF cmd$ = "" THEN EXIT SUB
  788.  
  789. c$ = ","+LEFT$(cmd$,INSTR(cmd$," ")-1)+","
  790. c = INSTR(noun$,c$)
  791. IF c = 0 THEN EXIT SUB
  792. cmd$ = MID$(cmd$,LEN(c$))
  793. WHILE (MID$(cmd$,1,1) = " ")
  794.   cmd$ = MID$(cmd$,2)
  795. WEND
  796. GOTO SkipNoun1
  797.  
  798. END SUB
  799.  
  800. ' GetNoun() uses ExNoun to return all possible noun code choices,
  801. ' and tries to resolve the ambiguity by calling ChooseVisible to
  802. ' see if the object is in the room or on the player.  If this
  803. ' fails, then tries using the vtype1 flag, and then the vtype2
  804. ' flag (see ChooseVisible for explanation of vtype.)  (vtype1 is
  805. ' nounat(verb) and vtype2 is noundef(verb) (see Commands for
  806. ' explanation of nounat and noundef.))
  807. ' Returns ch = -1 for inconsistent nouns
  808. ' Returns ch = -2 for ambiguity not resolved by visual check
  809. ' Returns that = 1 if a "that" clause follows
  810. ' See ExNoun() and ChooseVisible()
  811. SUB GetNoun(cmd$,choice(2),ch,n,vtype1,vtype2,that) STATIC
  812. SHARED c1()
  813. z = 0
  814. c1(0) = 0:c1(1) = vtype1:c1(2) = vtype2
  815. IF vtype1 <> c1(z) THEN z = z + 1:c1(z) = vtype1
  816. IF vtype2 <> c1(z) THEN z = z + 1:c1(z) = vtype2
  817.  
  818. och = ch
  819. CALL ExNoun(cmd$,choice(),ch,that)
  820. IF that THEN IF ch = och THEN EXIT SUB
  821. IF ch = 1 THEN
  822.    n = choice(1,0)
  823. ELSEIF ch = -1 THEN
  824.    EXIT SUB
  825. ELSE  '*** Try to resolve ambiguity
  826.    FOR i = 0 TO z
  827.       CALL ChooseVisible(choice(),ch,c1(i))
  828.       IF ch = 1 THEN 'Found it
  829.          n = choice(1,0)
  830.          EXIT SUB
  831.       ELSEIF ch < -1 AND i = 0 THEN 'Can't see anywhere
  832.          ch = -2
  833.          EXIT SUB
  834.       ELSEIF ch <= 0 THEN 'Return last step's ambiguity
  835.          ch = -ch
  836.          EXIT SUB
  837.       END IF
  838.    NEXT i
  839. END IF
  840.  
  841. END SUB
  842.  
  843. ' Get preposition
  844. SUB GetPrep(cmd$,p) STATIC
  845. SHARED prep$,prepn$()
  846.  
  847. WHILE (1)
  848. IF cmd$ = "" THEN EXIT SUB
  849. c$ = ","+LEFT$(cmd$,INSTR(cmd$," ")-1)+","
  850. c = INSTR(prep$,c$)
  851. IF c = 0 THEN EXIT SUB
  852. lp = LEN(c$) - 2
  853. p = VAL(MID$(prep$,c + lp + 2))
  854. cmd$ = MID$(cmd$,lp + 2)
  855. WHILE (MID$(cmd$,1,1) = " ")
  856.   cmd$ = MID$(cmd$,2)
  857. WEND
  858. WEND
  859.  
  860. END SUB
  861.    
  862. ' Routine scans the choice array and returns an array with only
  863. ' visible items.  Returns the same array with a negative
  864. ' nchoice if none of the items are visible.
  865. ' If vtype is 1, then only checks to see if object is visible on the
  866. ' player, and if 2, then only checks if objects is visible in room,
  867. ' but not carried by player.  If 0, checks both places.
  868. SUB ChooseVisible(choice(2),nchoice,vtype) STATIC
  869. SHARED mhom
  870.  
  871. IF nchoice < 2 THEN EXIT SUB
  872. newnchoice = 0
  873. FOR i = 1 TO nchoice
  874.    CALL Visible(choice(i,0),vis,vtype)
  875.    IF (vis) THEN
  876.       newnchoice = newnchoice + 1
  877.       choice(newnchoice,1) = choice(i,0)
  878.    END IF
  879. NEXT i
  880. IF newnchoice = 0 THEN
  881.    nchoice = -nchoice
  882.    EXIT SUB
  883. ELSE
  884.    nchoice = newnchoice
  885.    FOR i = 1 TO nchoice
  886.       choice(i,0) = choice(i,1)
  887.    NEXT i
  888. END IF
  889. END SUB
  890.  
  891. ' Parses the cmd$ string and returns the next preposition and
  892. ' noun (used in a sentence like "get the water that's *in the bottle*")
  893. ' Returns -1 in tp if player overrided command in an AskAmbig process
  894. ' Returns -2 in tp if player makes a fatal grammatical error
  895. SUB GetThatClause(cmd$,tp,tn) STATIC
  896. SHARED nchoice2()
  897.  
  898. IF tp THEN GetThatClause1
  899. tn = 0:tp = 0
  900. CALL SkipNoun(cmd$)
  901. CALL GetPrep(cmd$,tp)
  902. GetThatClause1:
  903. IF tp < 1 OR tp > 4 THEN EXIT SUB
  904. nch = 0:ambig = 0:that = 0
  905. GetThatClause2:
  906. CALL GetNoun(cmd$,nchoice2(),nch,tn,0,0,that)
  907. IF that THEN
  908.    PRINT"Your language is too complex for me.  Please restate."
  909.    tp = -2
  910.    EXIT SUB
  911. END IF
  912. IF ambig = 1 AND nch = 0 THEN ' AskAmbig (see below) failed, so
  913.    cmd$ = amb$ ' assume that the player overrided the old command, and
  914.    tp = -1 ' return a -1 error flag
  915.    EXIT SUB
  916. ELSE
  917.    ambig = 0 ' Clear AskAmbig flag
  918. END IF
  919. IF nch = -1 THEN GOSUB Absurd:tp = -2:EXIT SUB
  920. IF nch = -2 THEN GOSUB Mystery:tp = -2:EXIT SUB
  921. IF nch > 1 THEN ' Ask player to resolve ambiguity
  922.    CALL AskAmbig(nchoice2(),nch,that)
  923.    IF that THEN PRINT"Wait a sec---I'm getting confused.  Let's start over from the beginning.":EXIT SUB
  924.    PRINT:LINE INPUT"> ";amb$:amb$ = amb$ + " ":PRINT
  925.    cmd$ = amb$ + cmd$:ambig = 1 ' (see above)
  926.    GOTO GetThatClause2 ' Try to resolve ambiguity
  927. END IF
  928. END SUB
  929.  
  930. ' Skips a clause of the form preposition-noun
  931. SUB SkipThatClause(cmd$) STATIC
  932.  
  933. CALL SkipNoun(cmd$)
  934. CALL GetPrep(cmd$,a)
  935. CALL SkipNoun(cmd$)
  936. END SUB
  937.  
  938. ' Attempts to resolve ambiguity by choosing only those
  939. ' items in array(,0) that are related to tn by mode tr
  940. ' (i.e., only objects that are "in" the "bottle", "on" the "table", etc.)
  941. SUB ResolveThat(array(2),nch,n,tr,tn) STATIC
  942. SHARED par(),rel(),mrel
  943.  
  944. IF tn<0 THEN EXIT SUB
  945. IF tr<0 OR tr>mrel THEN EXIT SUB
  946.  
  947. nnch = 0
  948. FOR i = 1 TO nch
  949.    IF array(i,0) < 0 THEN
  950.       nnch = nnch + 1
  951.       array(nnch,1) = array(i,0)
  952.    ELSEIF par(array(i,0)) = tn AND rel(array(i,0)) = tr THEN
  953.       nnch = nnch + 1
  954.       array(nnch,1) = array(i,0)
  955.    END IF
  956. NEXT
  957. nch = nnch
  958. FOR i = 1 TO nch
  959.    array(i,0) = array(i,1) ' Copy array to position zero
  960. NEXT
  961. IF nch = 1 THEN n = array(1,0)
  962. END SUB
  963.  
  964. Initialize:
  965. CLS
  966. PRINT"Welcome to "game$"!
  967. PRINT"One moment please . . ."
  968.  
  969. DEF FNcap$(a$) = CHR$(ASC(a$) AND 223) + MID$(a$,2)
  970. z$ = CHR$(8)
  971.  
  972. ' Stack for routines which recursively search object lists
  973. ' (Maximum stack depth 30)
  974. mdepth = 30
  975. DIM cc(mdepth),mc(mdepth)
  976.  
  977. ' General storage arrays for subroutines
  978. mlist = 50
  979. DIM c1(mlist),c2(mlist)
  980.  
  981. ' Read abstract descriptions
  982. RESTORE abstract
  983. READ mabs 'Maximum # of abstract nouns
  984. DIM abstract$(mabs),abstract(mabs)
  985. READ a
  986. WHILE (a <> 0)
  987.    READ abstract$(a)
  988.    READ a
  989.    IF a > nabs THEN nabs = a
  990. WEND
  991.  
  992. ' Read "folded" state
  993. RESTORE fold
  994. READ mfold
  995. DIM fold$(mfold)
  996. nfold = 0
  997. READ f$
  998. WHILE (f$ <> "")
  999.    nfold = nfold + 1
  1000.    fold$(nfold) = f$
  1001.    READ f$
  1002. WEND
  1003.  
  1004. ' Read verbs
  1005. RESTORE Verbs
  1006. DIM verb$(2)
  1007. nverb = 0
  1008. FOR i = 0 TO 2
  1009.    v = 1
  1010.    WHILE (v <> 0)
  1011.       READ v$,v
  1012.       verb$(i) = verb$(i) + "," + v$ + "," + STR$(v)
  1013.       IF v > nverb THEN nverb = v
  1014.    WEND
  1015. NEXT i
  1016.  
  1017. ' Read verb attributes (verbs must be in order!)
  1018. RESTORE Commands
  1019. DIM reqnoun(1,nverb),defprep(nverb),nounat(1,nverb)
  1020. DIM noundef(1,nverb),nounpl(1,nverb)
  1021. FOR i = 1 TO nverb
  1022.    READ reqnoun(0,i),reqnoun(1,i),defprep(i),nounat(0,i),nounat(1,i)
  1023.    READ noundef(0,i),noundef(1,i),nounpl(0,i),nounpl(1,i)
  1024. NEXT i
  1025.  
  1026. '*** Set the null verb's "attributes"
  1027. nounpl(0,0) = 2:nounpl(1,0) = 2
  1028.  
  1029. ' Read nouns
  1030. RESTORE Nouns
  1031. READ mnouns,mcode
  1032. DIM nindex(mnouns),nhom(mnouns),ncode(mcode)
  1033. noun$ = ""
  1034. nnoun = 0
  1035. mhom = 0:REM maximum number of homonyms for any noun
  1036. nbase = 0:REM start at base of ncode table
  1037. code = 0
  1038. READ n$
  1039. WHILE (n$ <> "")
  1040.    noun$ = noun$ + "," + n$ + "," + STR$(nnoun)
  1041.    hom = 0
  1042.    nindex(nnoun) = nbase
  1043.    READ code
  1044.    WHILE (code <> 0)
  1045.       ncode(nbase) = code
  1046.       nbase = nbase + 1
  1047.       hom = hom + 1
  1048.       READ code
  1049.    WEND
  1050.    nhom(nnoun) = hom
  1051.    IF hom > mhom THEN mhom = hom
  1052.    nnoun = nnoun + 1
  1053.    READ n$
  1054. WEND
  1055.  
  1056. ' Read prepositions
  1057. RESTORE Prepositions
  1058. prep$ = ""
  1059. nprep = 0
  1060. READ p$
  1061. WHILE (p$ <> "")
  1062.    READ p
  1063.    nprep = nprep + 1
  1064.    prep$ = prep$ + "," + p$ + "," + STR$(p)
  1065.    READ p$
  1066. WEND
  1067.  
  1068. ' Read preposition names
  1069. RESTORE Prepnames
  1070. DIM prepn$(nprep)
  1071. READ p$
  1072. nprepn = -1
  1073. WHILE (p$ <> "")
  1074.    nprepn = nprepn + 1
  1075.    prepn$(nprepn) = p$
  1076.    READ p$
  1077. WEND
  1078. imap:
  1079. ' Read map (see Locations: for details)
  1080. PRINT"I am reading the map . . ."
  1081. RESTORE map
  1082. READ mloc,avdes,mmcond,mfcond,avfcond
  1083. DIM map(mloc,9),Llight(mloc),Lon(mloc)
  1084. DIM dindex(mloc),des$(mloc * avdes)
  1085. DIM mcond(4,mloc),mmes$(mloc)
  1086. DIM findex(mloc),fcond(5,mfcond),fdes$(mfcond * avfcond)
  1087. REM N,NE,E,SE,S,SW,W,NW,U,D, water, light, lighton?
  1088. nloc = 1:ndes = 0:nmcond = 0:nfcond = 0:nfcdes = 0
  1089. READ l
  1090. WHILE (l <> 0)
  1091.    nloc = nloc + 1
  1092.    IF nloc <> l THEN PRINT"MAP IS IN BAD FORMAT AT LOC"nloc:STOP
  1093.    cmcond = 0 ' Count the number of map cond. in this location
  1094.    FOR i = 0 TO 9
  1095.       READ n
  1096.       IF (n < 0) AND (n > -99) THEN
  1097.          n = -n
  1098.          IF n > cmcond THEN cmcond = n
  1099.          map(l,i) = -nmcond - n
  1100.       ELSE
  1101.          map(l,i) = n
  1102.       END IF
  1103.    NEXT i
  1104.    READ Llight(l),Lon(l)
  1105.    FOR j = 1 TO cmcond ' Read map conditionals (if there are any)
  1106.       nmcond = nmcond + 1
  1107.       FOR k = 0 TO 4
  1108.          READ mcond(k,nmcond)
  1109.       NEXT k
  1110.       READ mmes$(nmcond)
  1111.    NEXT j
  1112.    dindex(l) = ndes
  1113.    READ des$(ndes) ' First line is short description (can be NULL)
  1114.    WHILE (des$(ndes) <> "") ' Succeeding lines are long descriptions
  1115.       ndes = ndes + 1
  1116.       READ des$(ndes)
  1117.    WEND
  1118.    READ a,b,c,d
  1119.    findex(l) = nfcond + 1
  1120.    WHILE (a <> -1) ' Read a flag conditional
  1121.       nfcond = nfcond + 1
  1122.       fcond(0,nfcond) = a:fcond(1,nfcond) = b:fcond(2,nfcond) = c
  1123.       fcond(3,nfcond) = d:fcond(4,nfcond) = nfcdes
  1124.       READ fdes$(nfcdes)
  1125.       WHILE (fdes$(nfcdes) <> "")
  1126.          nfcdes = nfcdes + 1
  1127.          READ fdes$(nfcdes)
  1128.       WEND
  1129.       READ a,b,c,d
  1130.    WEND
  1131.    READ l
  1132. WEND
  1133. dindex(nloc+1) = ndes:fcond(4,nfcond+1) = nfcdes ' Mark end of description lists
  1134. findex(nloc+1) = nfcond + 1 ' and mark end of flag lists
  1135.  
  1136. ' Read flags
  1137. ' Flag 1 is lamp on/off, flag 2 is daytime/nighttime
  1138. RESTORE Flags
  1139. READ mflag
  1140. nflag = 0
  1141. DIM flag(mflag)
  1142. READ f
  1143. WHILE (f)
  1144.    IF f>nflag THEN nflag = f
  1145.    READ flag(f),f
  1146. WEND
  1147.  
  1148. iobj:   
  1149. ' Read objects
  1150. DIM Lfirst(nloc),Llast(nloc),seen(nloc)
  1151. RESTORE Objects
  1152. READ mobj,mrel,mbot
  1153. DIM pre$(mobj),word$(mobj),adj$(mobj),long$(mobj)
  1154. DIM lo(mobj),par(mobj),rel(mobj)
  1155. DIM first(mrel,mobj),last(mrel,mobj),left(mobj),right(mobj)
  1156. DIM size(mobj),opening(mrel,mobj),cap(mrel,mobj),opaque(mrel,mobj)
  1157. DIM closed(mobj),openable(mobj)
  1158. DIM folded(mobj),foldable(mobj),locked(mobj),holdwater(mobj)
  1159. DIM worn(mobj),wearable(mobj),soft(mobj),food(mobj),immobile(mobj)
  1160. DIM totw(mobj),totb(mobj),bulk(mrel,mobj)
  1161. DIM bottles(mbot)
  1162. nbot = -1 ' Keep a list of bottles
  1163. ' Read objects
  1164. nobj = 0
  1165. READ n
  1166. WHILE (n <> 0)
  1167.    IF (n > nobj) THEN nobj = n
  1168.    READ pre$(n),word$(n),adj$(n),long$(n)
  1169.    READ lo(n),par(n),rel(n)
  1170.    READ size(n),wei
  1171.    FOR i = 0 TO mrel
  1172.        READ opening(i,n)
  1173.    NEXT i
  1174.    anycap = 0
  1175.    FOR i = 0 TO mrel
  1176.        READ cap(i,n)
  1177.        anycap = anycap OR cap(i,n)
  1178.    NEXT i
  1179.    FOR i = 0 TO mrel
  1180.        READ opaque(i,n)
  1181.    NEXT i
  1182.    READ closed(n),openable(n),folded(n),foldable(n),locked(n)
  1183.    READ holdwater(n),worn(n),wearable(n),soft(n),food(n),immobile(n)
  1184.    IF holdwater(n) THEN nbot = nbot + 1:bottles(nbot) = n
  1185.    totw(n) = wei
  1186.    totb(n) = size(n)
  1187.    IF par(n) <> 0 OR immobile(n) = 0 OR anycap <> 0 THEN
  1188.       IF par(n) THEN
  1189.          CALL Insert(n,par(n),rel(n))
  1190.       ELSE
  1191.          CALL Insert(n,-lo(n),0)
  1192.       END IF
  1193.    END IF
  1194.    READ n: REM next object
  1195. WEND
  1196.  
  1197. Arrays:
  1198. ' Arrays hold homonyms for ambiguity resolution
  1199. DIM nchoice(mhom + 2,1),nchoice2(mhom + 2,1)
  1200.  
  1201. ' Arrays hold lists of nouns and objects
  1202. DIM lnoun(1,mlist),nlnoun(1),ncount(1),olnoun(mlist)
  1203. DIM mnoun(1,mlist),mlnoun(1),mcount(1)
  1204.  
  1205. ' Commands can be superseded temporarily by other commands (e.g.,
  1206. ' if you say "wear hat" you must first "take" it; the program will
  1207. ' automatically do this) But for the sake of the multiple-noun
  1208. ' sequences, etc., the command must be restored to its original
  1209. ' form, even if it has been superseded.  Thus, you use RecordCommand
  1210. ' and RestoreCommand to store this activity on a "command stack".
  1211. ' The Alias() subprogram does this automatically for you.
  1212. mrlev = 10 ' Maximum ten (!) levels of command stack
  1213. DIM vo(mrlev),po(mrlev),no(mrlev,1)
  1214. DIM vo$(mrlev),po$(mrlev),no$(mrlev,1),nno$(mrlev,1)
  1215.  
  1216. ' Arrays hold the direct object and indirect object
  1217. DIM n(1),n$(1),nn$(1)
  1218.  
  1219. Initvals:
  1220. GOSUB Flags ' Set mnemonic variables
  1221. fdindex = 4 ' internal use constant (see Look:)
  1222. fseen = 5 ' internal use constant (see SaveGame: and Look:)
  1223.  
  1224. ' Setup starting values
  1225. l = 2:ol = 2:REM You start in room 2
  1226. t = flag(tim):REM time is kept by flag variable "tim"
  1227. GOSUB ClearCommand:FOR z = 0 TO 1:ncount(z) = 0:nlnoun(z) = 0:NEXT
  1228. v = 1:REM "Look" is the first command
  1229. v$ = "look"
  1230.  
  1231. Player:
  1232. maxcap = 15:maxweight = 50:REM Player's capacity, total weight capacity
  1233. maxgrab = 20:maxlift = 40:REM Maximum size, weight, player can lift (see Take:)
  1234. fat = 20:REM Size of player while sitting (3*fat is size when lying down)
  1235.  
  1236. GOTO PreProcess
  1237.  
  1238. NewCommand:
  1239. rlev = 0 ' Clear command stack
  1240. GOSUB RecordCommand
  1241. GOSUB ClearCommand
  1242. GOSUB ClearList
  1243. ncmd$ = "":GOTO InCommand
  1244.  
  1245. ContCommand:
  1246. rlev = 0 ' Clear command stack
  1247. GOSUB RecordCommand
  1248. ncmd$ = "":GOTO InCommand
  1249.  
  1250. GetCommand:
  1251. rlev = 0 ' Clear command stack
  1252. IF nlnoun(1) THEN '*** take care of multiple indirect objects
  1253.    ncount(1) = ncount(1) + 1
  1254.    IF ncount(1) <= nlnoun(1) THEN
  1255.       n(1) = lnoun(1,ncount(1))
  1256.       CALL NameNoun(n(1),n$(1),nn$(1))
  1257.       PRINT p$" "nn$(1)": ";
  1258.       GOTO Filter
  1259.    END IF
  1260. END IF
  1261. IF nlnoun(0) THEN '*** take care of multiple direct objects
  1262.    ncount(0) = ncount(0) + 1
  1263.    IF ncount(0) <= nlnoun(0) THEN
  1264.       ncount(1) = 1
  1265.       IF nlnoun(1) THEN n(0) = lnoun(1,1)
  1266.       n(0) = lnoun(0,ncount(0))
  1267.       CALL NameNoun(n(0),n$(0),nn$(0))
  1268.       PRINT nn$(0)": ";
  1269.       GOTO Filter
  1270.    END IF   
  1271. END IF
  1272. GOSUB RecordCommand
  1273. GOSUB ClearCommand
  1274. GOSUB ClearList
  1275.  
  1276. InCommand:
  1277. PRINT
  1278. IF ncmd$ = "" THEN
  1279.    LINE INPUT"> ";cmd$:PRINT:cmd$ = cmd$ + " "
  1280. ELSE
  1281.    GOSUB waitforesc:IF a$ = CHR$(27) THEN NewCommand
  1282.    cmd$ = ncmd$
  1283. END IF
  1284.  
  1285. Parse: ' Take care of grammatical quirks
  1286. a = INSTR(cmd$,".") ' Periods
  1287. IF (a) THEN
  1288.    ncmd$ = MID$(cmd$,a+1)
  1289.    WHILE (MID$(ncmd$,1,1) = " ")
  1290.       ncmd$ = MID$(ncmd$,2)
  1291.    WEND
  1292.    cmd$ = LEFT$(cmd$,a-1) + " "
  1293. ELSE
  1294.    ncmd$ = ""
  1295. END IF
  1296. a = INSTR(cmd$,",and ") ' Replace commas
  1297. WHILE (a)
  1298.    cmd$ = LEFT$(cmd$,a-1)+" and "+MID$(cmd$,a+5)
  1299.    a = INSTR(cmd$,",and ")
  1300. WEND
  1301. a = INSTR(cmd$,", and ")
  1302. WHILE (a)
  1303.    cmd$ = LEFT$(cmd$,a-1)+" and "+MID$(cmd$,a+6)
  1304.    a = INSTR(cmd$,", and ")
  1305. WEND
  1306. a = INSTR(cmd$,",")
  1307. WHILE (a)
  1308.    cmd$ = LEFT$(cmd$,a-1)+" and "+MID$(cmd$,a+1)
  1309.    a = INSTR(cmd$,",")
  1310. WEND
  1311. WHILE (MID$(cmd$,1,1) = " ") ' Get rid of excess spaces
  1312.    cmd$ = MID$(cmd$,2)
  1313. WEND
  1314.  
  1315. Interpret: ' nn is the noun number (0 = direct obj, 1 = indirect obj)
  1316. IF cmd$ = "" THEN PRINT"Say what?":GOTO ContCommand
  1317. nlnoun(0) = 0:nlnoun(1) = 0 '*** stop multiple noun loops
  1318. ocmd$ = cmd$:locmd=LEN(ocmd$)
  1319. IF noobj THEN v = 0 '*** See Filter: for origin of noobj flag
  1320. CALL GetVerb(cmd$,v,v$)
  1321. IF noobj THEN
  1322.    IF v <> 0 AND v <> vo THEN
  1323.       vo=v:vo$=v$
  1324.       GOSUB ClearCommand '*** User can override old verb
  1325.       v=vo:v$=vo$
  1326.    ELSE
  1327.       v=vo
  1328.    END IF
  1329. END IF
  1330. IF cmd$ = "" THEN PreProcess
  1331. IF noobj THEN InPrep
  1332.  
  1333. ambig=0:but=0:cand=0:nch=0:that=0:nn=0
  1334. InNoun:
  1335. CALL GetNoun(cmd$,nchoice(),nch,n(nn),nounat(nn,v),noundef(nn,v),that)
  1336. IF nch = -1 THEN PRINT"I don't understand what you're talking about.":GOTO NewCommand
  1337. IF nch = -2 THEN GOSUB Mystery:GOTO NewCommand
  1338. IF nn = 0 THEN
  1339.    IF cmd$<>"" AND nounpl(1,v) = 0 THEN ' default "that" clause?
  1340.       tn=0:c=0:CALL GetPrep(cmd$,c)
  1341.       IF c > 0 AND c < 8 THEN
  1342.          tp=c:that=1:GOTO InThatClause
  1343.       ELSE ' Message for InPrep not to scan again for a preposition
  1344.          trp=c
  1345.       END IF
  1346.    END IF
  1347. END IF
  1348. IF that THEN ' "that" clause
  1349.    tp=0:tn=0
  1350. InThatClause:
  1351.    IF nch = 0 THEN
  1352.       CALL SkipThatClause(cmd$)
  1353.    ELSE
  1354.       CALL GetThatClause(cmd$,tp,tn)
  1355.       IF tp = -1 THEN Parse
  1356.       IF tp = -2 THEN NewCommand
  1357.       IF ambig = 1 AND tn = 0 THEN 'Ambig resolution failed, so
  1358.          GOTO Parse ' assume player overrided old command and start over
  1359.       END IF
  1360.       IF tp < 0 OR tp > 4 OR tn = 0 THEN
  1361.          IF cmd$ <> "" THEN
  1362.             PRINT"I don't know what you mean by '"cmd$"'.
  1363.             GOTO NewCommand
  1364.          ELSE
  1365.             PRINT"That's . . . what?" ' Try to resolve ambiguity
  1366.             PRINT:LINE INPUT"> ";cmd$:cmd$=cmd$+" ":PRINT
  1367.             ambig=1:GOTO InThatClause
  1368.          END IF
  1369.       END IF
  1370.       CALL ResolveThat(nchoice(),nch,n(nn),tp-1,tn)
  1371.       IF nch = 0 THEN GOSUB Mystery:GOTO NewCommand
  1372.    END IF
  1373. END IF
  1374. IF ambig = 1 AND nch = 0 THEN ' AskAmbig (see below) failed, so
  1375.    cmd$=amb$ ' assume that the player overrided the old command, and
  1376.    GOTO Parse  ' start over
  1377. ELSE
  1378.    ambig = 0 ' Clear AskAmbig flag
  1379. END IF
  1380. IF nch > 1 THEN ' Ask player to resolve ambiguity
  1381.    that = 0:CALL AskAmbig(nchoice(),nch,that)
  1382.    PRINT:LINE INPUT"> ";amb$:amb$ = amb$ + " ":PRINT
  1383.    cmd$ = amb$ + cmd$:ambig = 1 ' (see above)
  1384.    GOTO InNoun ' Try to resolve ambiguity
  1385. END IF
  1386. IF nch THEN
  1387.    IF n(nn) = -12 THEN ' Resolve pronoun ambiguity
  1388.       IF no(0,1) > 0 THEN ' Choose last noun referenced
  1389.          n(nn)=no(0,1)
  1390.       ELSEIF no(0,0) > 0 THEN
  1391.          n(nn)=no(0,0)
  1392.       ELSE
  1393.          n(nn)=0
  1394.       END IF
  1395.       IF n(nn) <> 0 THEN
  1396.          CALL NameNoun(n(nn),n$,nn$)
  1397.          IF nn = 0 THEN
  1398.             PRINT"("nn$")
  1399.          ELSE
  1400.             PRINT"("p$" "nn$")
  1401.          END IF
  1402.       END IF
  1403.    END IF
  1404.    IF but = 0 THEN ' "and" clause
  1405.       IF n(nn) = -11 THEN ' this is the "all" noun
  1406.          na = noundef(nn,v):IF na = 0 THEN na = 3
  1407.          IF that = 1 AND tp > 0 AND tn > 0 THEN ' everything that's in ...
  1408.             that = 0
  1409.             CALL Visible(tn,vis,0)
  1410.             IF vis = 0 THEN GOSUB Mystery:GOTO NewCommand
  1411.             ' Place test particle in tn, relation tp-1, to see if
  1412.             ' stuff in there is visible or not
  1413.             lo(0)=lo(tn):par(0)=tn:rel(0)=tp-1
  1414.             CALL Visible(0,vis,0)
  1415.             IF vis THEN
  1416. ThatAgain:
  1417.                CALL ListSib(first(tp-1,tn),lnoun(),nlnoun(),nn)
  1418.             ELSE
  1419.                IF closed(tn) THEN
  1420.                   PRINT"(opening the "word$(tn)" first): ";
  1421.                   CALL Alias("open",8,(tn),0,0):GOSUB OpenIt
  1422.                   GOSUB RestoreCommand
  1423.                   lo(0)=lo(tn):par(0)=tn:rel(0)=tp-1
  1424.                   CALL Visible(0,vis,0)
  1425.                   IF vis=0 THEN NewCommand ELSE GOTO ThatAgain
  1426.                ELSE
  1427.                   GOSUB Mystery:GOTO NewCommand
  1428.                END IF
  1429.             END IF
  1430.          ELSE
  1431.             IF na AND 1 THEN CALL ListSib(first(1,1),lnoun(),nlnoun(),nn)
  1432.             IF na AND 2 THEN CALL ListSib(Lfirst(l),lnoun(),nlnoun(),nn)
  1433.          END IF
  1434.          IF nlnoun(nn) = 0 THEN n(nn) = 0 ELSE n(nn) = lnoun(nn,1)
  1435.       ELSEIF n(nn) = -13 THEN ' plural pronoun
  1436.          IF ncount(nn) = 0 THEN
  1437.             FOR i = 1 TO onlnoun
  1438.                nlnoun(nn) = nlnoun(nn) + 1
  1439.                lnoun(nn,nlnoun(nn)) = olnoun(i)
  1440.             NEXT
  1441.             IF nlnoun(nn) = 0 THEN n(nn) = 0 ELSE n(nn) = lnoun(nn,1)
  1442.          END IF
  1443.       ELSEIF n(nn) <> 0 THEN
  1444.          nlnoun(nn) = nlnoun(nn) + 1
  1445.          lnoun(nn,nlnoun(nn)) = n(nn)
  1446.       END IF
  1447.    ELSE '"but" clause
  1448.       IF n(nn) = -11 THEN PRINT"You humans have a strange way of speaking.":GOTO NewCommand
  1449.       IF n(nn) = -13 THEN ' plural pronoun
  1450.          FOR i = 1 TO onlnoun
  1451.             a = 0
  1452.             FOR j = 1 TO nlnoun(nn)
  1453.                IF lnoun(nn,j) = olnoun(i) THEN a=1:nlnoun(nn)=nlnoun(nn)-1
  1454.                IF a THEN lnoun(nn,i) = lnoun(nn,i+1)
  1455.             NEXT
  1456.          NEXT
  1457.       ELSE ' single word
  1458.          a = 0
  1459.          FOR i = 1 TO nlnoun(nn)
  1460.             IF lnoun(nn,i) = n(nn) THEN a = 1:nlnoun(nn) = nlnoun(nn) - 1
  1461.             IF a THEN lnoun(nn,i) = lnoun(nn,i+1)
  1462.          NEXT
  1463.       END IF
  1464.       IF nlnoun(nn) THEN n(nn) = lnoun(nn,1) ELSE n(nn) = 0
  1465.    END IF
  1466. ELSE
  1467.    IF cand = 1 THEN ncmd$ = cmd$+"."+ncmd$:cmd$ = "":GOTO PreProcess
  1468. END IF
  1469. IF cmd$ = "" THEN PreProcess
  1470.  
  1471. InPrep:
  1472. lcmd = LEN(cmd$)
  1473. c = 0:IF trp THEN c=trp:trp=0 ELSE CALL GetPrep(cmd$,c)
  1474. IF c = 0 THEN PreProcess
  1475. IF c < 8 AND nn = 0 THEN p = c:ploc = locmd-lcmd ' Record prep location
  1476. IF cmd$ = "" THEN PreProcess
  1477. IF (c = 8 AND nn = 0 AND n(0) = 0) THEN
  1478.    ncmd$ = cmd$ + "." + ncmd$
  1479.    cmd$ = ""
  1480.    GOTO PreProcess
  1481. END IF
  1482. IF c = 8 THEN cand = 1:nch = 0:that = 0:GOTO InNoun ' and ...
  1483. IF c = 9 THEN but = 1:nch = 0:that = 0:GOTO InNoun ' but ...
  1484. IF nn = 1 THEN ' What!? Insert a "that's" and start over
  1485.    IF warnthat < 3 THEN
  1486.       warnthat = warnthat + 1
  1487.       PRINT"(Please use more specific language in the future, e.g.,
  1488.       PRINT CHR$(34)LEFT$(ocmd$,ploc)"THAT'S "MID$(ocmd$,ploc+1)CHR$(8)CHR$(34)"-Ed.)
  1489.    END IF
  1490.    GOSUB ClearCommand:GOSUB ClearList
  1491.    cmd$ = LEFT$(ocmd$,ploc)+"that's "+MID$(ocmd$,ploc+1)
  1492.    ocmd$ = cmd$:locmd = LEN(ocmd$)
  1493.    GOTO Parse
  1494. END IF
  1495. nn = 1:but = 0:cand = 0:nch = 0:that = 0:GOTO InNoun 'Get indirect object
  1496.  
  1497. PreProcess:
  1498. nn = 0:p$ = prepn$(p)
  1499. FOR i = 0 TO 1
  1500.    IF n(i) <> 0 THEN CALL NameNoun(n(i),n$(i),nn$(i))
  1501. NEXT
  1502. IF cmd$ <> "" THEN
  1503.    cmd$ = LEFT$(cmd$,LEN(cmd$) - 1)
  1504.    PRINT"I don't know what you mean by '"cmd$CHR$(8)"'.
  1505.    GOTO NewCommand
  1506. END IF
  1507. FOR i = 0 TO 1
  1508.    IF nlnoun(i) = 1 THEN nlnoun(i) = 0
  1509. NEXT
  1510. FOR i = 0 TO 1
  1511.    IF nlnoun(i) THEN
  1512.       IF nounpl(i,v) < 2 THEN
  1513.          PRINT"You can't use multiple ";
  1514.          IF i = 1 THEN PRINT"indirect ";
  1515.          PRINT"objects with '"v$"'!
  1516.          GOTO NewCommand
  1517.       END IF
  1518.    END IF
  1519. NEXT
  1520.  
  1521. IF nlnoun(0) > 0 OR nlnoun(1) > 0 THEN GetCommand
  1522.  
  1523. Filter:
  1524. '*** grammatical replacements
  1525. IF (n(0)<0) AND (n(0)>=-10) AND (v = 0) THEN v = 6: v$="go"
  1526. IF v = 3 THEN IF n(1) <> 0 THEN v = 7 ' "drop xxx on yyy" == "put xxx on yyy"
  1527. IF v = 0 AND n(0) = 0 AND n(1) = 0 THEN PRINT"I don't understand.":GOTO NewCommand
  1528.  
  1529. FOR i = 0 TO 1
  1530.    IF n(i) <> 0 AND nounpl(i,v) = 0 THEN
  1531.       PRINT"You can't use ";
  1532.       IF i = 1 THEN PRINT"indirect ";
  1533.       PRINT"objects with '"v$"'!
  1534.       GOTO NewCommand
  1535.    END IF
  1536. NEXT
  1537. IF v = 0 AND n(0) <> 0 THEN
  1538.    PRINT"What do you want to do with "nn$(0)"?
  1539.    GOTO ContCommand
  1540. END IF
  1541. IF v = 0 AND n(1) <> 0 THEN
  1542.    PRINT". . . "prepn$(p)" "nn$(1)"?
  1543.    GOTO ContCommand
  1544. END IF
  1545. FOR i = 0 TO 1
  1546.    IF reqnoun(i,v) THEN
  1547.       na = noundef(i,v):IF na = 0 THEN na = 3
  1548.       IF n(i) = 0 THEN
  1549.          IF na AND 1 THEN CALL ListSib(first(1,1),lnoun(),nlnoun(),i)
  1550.          IF na AND 2 THEN CALL ListSib(Lfirst(l),lnoun(),nlnoun(),i)
  1551.          IF nlnoun(i) = 1 THEN
  1552.             n(i) = lnoun(i,1):ncount(i) = 1
  1553.             CALL NameNoun(n(i),n$(i),nn$(i))
  1554.             IF i = 0 THEN
  1555.                PRINT"("nn$(i)")
  1556.             ELSE
  1557.                IF p = 0 THEN p = defprep(v):p$ = prepn$(p)
  1558.                PRINT"("p$" "nn$(i)")
  1559.             END IF
  1560.          ELSE
  1561.             IF i = 0 THEN
  1562.                PRINT FNcap$(v$)" what?":GOTO ContCommand
  1563.             ELSE
  1564.                IF p = 0 THEN p = defprep(v):p$ = prepn$(p)
  1565.                PRINT FNcap$(v$)" "nn$(0)" "p$" what?":noobj = 1:GOTO ContCommand
  1566.             END IF
  1567.          END IF
  1568.       END IF
  1569.       CALL Visible(n(i),vis,0)
  1570.       IF vis = 0 THEN CALL CantSee(nn$(i)):GOTO GetCommand
  1571.       IF reqnoun(i,v) = 2 THEN ' Check physical accessibility
  1572.          pa = par(n(i))
  1573. TryAvail:
  1574.          CALL Avail(n(i),ava,0)
  1575.          IF ava = 0 THEN ' Try to open next parent up if still not accessible
  1576.             IF pa = 0 OR closed(pa) = 0 THEN ToNoAvail
  1577.             CALL Visible(pa,vis,0):IF vis = 0 THEN ToNoAvail
  1578.             PRINT"(opening the "word$(pa)" first): ";
  1579.             CALL Alias("open",8,(pa),0,0):GOSUB OpenIt
  1580.             GOSUB RestoreCommand
  1581.             IF closed(pa) <> 0 THEN ToNoAvail
  1582.             pa = par(pa):GOTO TryAvail
  1583. ToNoAvail:
  1584.             CALL CantGetAt(nn$(i)):GOTO GetCommand
  1585.          END IF
  1586.       END IF   
  1587.    END IF
  1588. NEXT
  1589. FOR i = 0 TO 1
  1590.    IF nounat(i,v) THEN
  1591.       IF n(i) < 0 THEN
  1592.          GOSUB Absurd:GOTO GetCommand
  1593.       ELSEIF nounat(i,v) = 1 AND n(i) > 0 THEN
  1594.          IF lo(n(i)) <> 1 THEN
  1595.             CALL Avail(n(i),ava,2)
  1596.             IF ava = 0 THEN CALL DontHave(nn$(i)):GOTO GetCommand
  1597.             PRINT"(taking "nn$(i)" first): ";
  1598.             CALL Alias("get",2,(n(i)),0,0):GOSUB Take
  1599.             GOSUB RestoreCommand
  1600.             IF lo(n)<>1 THEN NewCommand
  1601.          END IF
  1602.       END IF
  1603.    END IF
  1604. NEXT
  1605. DoCommand:
  1606. ' The variables n and o hold the values of n(0) and n(1), respectively
  1607. ' (the direct and indirect object).  These variables are used as a
  1608. ' kind of shorthand to make the verb routines easier to read.
  1609. n = n(0):o = n(1)
  1610.  
  1611. ' See PostProcess for the meaning of the ask flag (set by the verb routine)
  1612. ask = 0
  1613.  
  1614. IF v = 0 OR v > 33 THEN
  1615.    PRINT"DoCommand: Unrecognized verb '"v$"', code"STR$(v)".
  1616.    GOTO PostProcess
  1617. END IF
  1618.  
  1619. IF v < 6 THEN ON v GOSUB Look,Take,Drop,Inventory,Examine:GOTO PostProcess
  1620. IF v < 11 THEN ON v - 5 GOSUB go,Place,OpenIt,CloseIt,Lock:GOTO PostProcess
  1621. IF v < 16 THEN ON v - 10 GOSUB Unlock,TurnOn,TurnOff,Wordy,Brief:GOTO PostProcess
  1622. IF v < 21 THEN ON v - 15 GOSUB Superbrief,SaveGame,LoadGame,PutOn,TakeOff:GOTO PostProcess
  1623. IF v < 26 THEN ON v - 20 GOSUB Wrap,UnWrap,Restart,Again,Empty:GOTO PostProcess
  1624. IF v < 31 THEN ON v - 25 GOSUB Fill,Eat,Drink,Sit,Stand:GOTO PostProcess
  1625. IF v < 36 THEN ON v - 30 GOSUB Lie,QuitGame,DrinkAll:GOTO PostProcess
  1626.  
  1627. PostProcess:
  1628. ON ask GOTO ContCommand,NewCommand,Interpret
  1629. t = t + 1:flag(tim) = t ' Time marches on . . .
  1630. ol = l ' Keep track of where we are
  1631. GOTO GetCommand
  1632.  
  1633. ' Record last command on the command stack (push command stack)
  1634. RecordCommand:
  1635. vo(rlev) = v:po(rlev) = p:vo$(rlev) = v$:po$(rlev) = p$
  1636. FOR z = 0 TO 1
  1637.    no(rlev,z) = n(z):no$(rlev,z) = n$(z):nno$(rlev,z) = nn$(z)
  1638. NEXT
  1639. rlev = rlev + 1
  1640. RETURN
  1641.  
  1642. ' Clear current command (clear top of stack)
  1643. ClearCommand:
  1644. v$ = "":p$ = ""
  1645. v = 0:n = 0:p = 0:o = 0
  1646. FOR z = 0 TO 1
  1647.    n(z) = 0:n$(z) = "":nn$(z) = ""
  1648. NEXT
  1649. ' Reset interpreter flags
  1650. noobj = 0
  1651. RETURN
  1652.  
  1653. ' Clear and record multiple noun lists
  1654. ClearList:
  1655. z1 = 0:onlnoun = nlnoun(0):IF nlnoun(1) THEN onlnoun = nlnoun(1):z1 = 1
  1656. FOR z = 1 TO onlnoun
  1657.    olnoun(z) = lnoun(z1,z)
  1658. NEXT
  1659. FOR z = 0 TO 1
  1660.    nlnoun(z) = 0:ncount(z) = 0
  1661. NEXT
  1662. RETURN
  1663.  
  1664. ' Restore recorded command (pop command stack)
  1665. RestoreCommand:
  1666. rlev = rlev - 1:IF rlev < 0 THEN rlev = 0
  1667. v$ = vo$(rlev):p$ = po$(rlev)
  1668. v = vo(rlev):p = po(rlev)
  1669. FOR z = 0 TO 1
  1670.    n(z) = no(rlev,z):n$(z) = no$(rlev,z):nn$(z) = nno$(rlev,z)
  1671. NEXT
  1672. n = n(0):o = n(1)
  1673. RETURN
  1674.  
  1675. ' Pushes the command stack with a new command
  1676. SUB Alias(av$,av,n0,ap,n1) STATIC
  1677. SHARED n(),vo(),no(),po()
  1678. SHARED vo$(),n$(),nn$(),nno$(),no$(),po$(),prepn$()
  1679. SHARED v$,v,n,p,p$,o,rlev
  1680.  
  1681. vo(rlev) = v:po(rlev) = p:vo$(rlev) = v$:po$(rlev) = p$
  1682. FOR i = 0 TO 1
  1683.    no(rlev,i) = n(i):no$(rlev,i) = n$(i):nno$(rlev,i) = nn$(i)
  1684. NEXT
  1685. rlev = rlev + 1
  1686. v$ = "":p$ = ""
  1687. v = 0:n = 0:p = 0:o = 0
  1688. FOR i = 0 TO 1
  1689.    n(i) = 0:n$(i) = "":nn$(i) = ""
  1690. NEXT
  1691. v$=av$:v=av:n(0)=n0:n(1)=n1:IF ap THEN p=ap:p$=prepn$(p)
  1692. IF n(0) THEN CALL NameNoun(n(0),n$(0),nn$(0))
  1693. IF n(1) THEN CALL NameNoun(n(1),n$(1),nn$(1))
  1694. n=n(0):o=n(1)
  1695. END SUB
  1696.  
  1697. Commands:
  1698. ' The first DATA statement for each verb has the following
  1699. ' meaning:
  1700. '
  1701. '    DATA require_direct_object?,require_indirect_object?,defaultprep?
  1702. '
  1703. ' The first two numbers have the following meanings:
  1704. '   0 - not required
  1705. '   1 - must be visible (see Calc:Visible())
  1706. '   2 - must be physically accessible (see Calc:Avail())
  1707. '
  1708. ' defaultprep? is either 0 for no default preposition,or a prep number
  1709. ' (see Prepositions:)
  1710. '
  1711. ' The next line is: 
  1712. '
  1713. '    DATA direct_object_location?,indirect_object_location?
  1714. '
  1715. '   0 - no checking done
  1716. '   1 - player must be carrying the item
  1717. '   2 - the item should be in the same location as the player
  1718. '
  1719. ' The third line means:
  1720. '
  1721. '    DATA direct_obj_default_location?,indirect_obj_default_location?
  1722. '
  1723. ' The codes are the same as above, except that these are used in the
  1724. ' "verb all" and "verb what?" ambiguity resolution routines to determine
  1725. ' where to look.  This is usually the same as above, but in some cases
  1726. ' the verb is *usually* used for one purpose but may be used for another;
  1727. ' e.g., "get" which is usually used to get objects from the room but
  1728. ' may be used to get an object out of a container the player is
  1729. ' carrying.  In this case the default (room) is different from the
  1730. ' required (either room or player).
  1731. ' The fourth means:
  1732. '
  1733. '    DATA number_direct_objects?,number_indirect_objects?
  1734. '
  1735. ' If the number is 0, can have no nouns.
  1736. ' If 1, can only have a single noun.
  1737. ' If 2, can have single and plural (no checking is done).
  1738. '
  1739. ' Finally, if the verb wishes to ask a question or report an error,
  1740. ' the flag 'ask' can be set to the following values:
  1741. '     1 - return to input line but keep context (as in "get what?")
  1742. '     2 - return to input line (interrupt a multiple-command line)
  1743. '          (usually used after some error message has been given)
  1744. '          (throw away context)
  1745. '     3 - go to Interpret after returning, and reprocess the
  1746. '          verb, noun, object codes (see Again:)
  1747. '
  1748. ' See PreProcess:, DoCommand:, and PostProcess:
  1749.  
  1750. Look:
  1751. DATA 0,0,0
  1752. DATA 0,0
  1753. DATA 0,0
  1754. DATA 0,0
  1755.  
  1756. IF l = 0 THEN PRINT"Can't go that way.":l = ol:RETURN
  1757.  
  1758. IF map(l,0) <> -99 THEN
  1759.    CALL CheckLight(flag(1))
  1760.    IF (flag(1) = 0) THEN PRINT"It's too dark to see.":RETURN
  1761. END IF
  1762.  
  1763. IF (l > nloc) OR l < 2 THEN
  1764.    PRINT"You are in room "l", which is manifestly impossible.
  1765.    RETURN
  1766. END IF
  1767.  
  1768. ' Display description
  1769. ' This code can be changed to get a description off of a random file
  1770. ' from disk
  1771. longdes = 0
  1772. IF dindex(l) <> dindex(l+1) THEN
  1773.    IF des$(dindex(l)) <> " " THEN PRINT des$(dindex(l))
  1774.    IF ((seen(l) = 0 OR flag(verbose) = 1 OR v = 1) AND flag(verbose) <> -1) OR des$(dindex(l)) = " " THEN
  1775.       longdes = 1 ' We are printing the long description
  1776.       FOR i = dindex(l) + 1 TO dindex(l + 1) - 1
  1777.          IF des$(i) = "z" THEN
  1778.             GOSUB waitforkey
  1779.          ELSE
  1780.             PRINT des$(i)
  1781.          END IF
  1782.       NEXT i
  1783.       seen(l) = 1 'Jack was here
  1784.    END IF
  1785. END IF
  1786.  
  1787. ' Display conditional descriptions
  1788. FOR i = findex(l) TO findex(l + 1) - 1
  1789.    CALL EvalCond(fcond(0,i),fcond(1,i),fcond(2,i),true)
  1790.    IF true AND ((fcond(3,i) AND 1) <> 0 OR longdes = 1) AND NOT ((fcond(3,i) AND 1)= 0 AND flag(verbose) = -1) THEN
  1791.       IF (fcond(3,i) AND 2) = 0 OR fcond(fseen,i) = 0 THEN ' Check for one-time-only
  1792.          FOR j = fcond(fdindex,i) TO fcond(fdindex,i + 1) - 1
  1793.             IF fdes$(j) = "z" THEN
  1794.                GOSUB waitforkey
  1795.             ELSE
  1796.                PRINT fdes$(j)
  1797.             END IF
  1798.          NEXT j
  1799.          fcond(fseen,i) = 1 ' We've seen this one now
  1800.       END IF
  1801.    END IF
  1802. NEXT
  1803.  
  1804. IF Lfirst(l) THEN
  1805.    PRINT"Here, you see:
  1806.    CALL Contents(Lfirst(l),3,0)
  1807. END IF
  1808.  
  1809. ' Check for forced move
  1810. IF map(l,0) = -99 THEN
  1811.    CALL EvalCond(map(l,1),map(l,2),map(l,3),true)
  1812.    IF true THEN nl = map(l,4) ELSE nl = map(l,5)
  1813.    IF nl = -99 THEN
  1814.       l = ol ' Bounce back
  1815.       RETURN
  1816.    ELSE
  1817.       l = nl ' Don't want absurd negative locations
  1818.       PRINT
  1819.       GOTO Look ' Describe new location
  1820.    END IF
  1821. END IF
  1822. RETURN
  1823.  
  1824. waitforesc:
  1825. PRINT"[press any key or ESC]";:GOTO getkey
  1826. waitforkey:
  1827. PRINT"[press any key]";
  1828. getkey:
  1829. a$ = INKEY$
  1830. WHILE(a$ = "")
  1831.    a$ = INKEY$
  1832. WEND
  1833. ' Erase message
  1834. PRINT z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$;
  1835. RETURN
  1836.  
  1837. Take:
  1838. DATA 2,0,0
  1839. DATA 0,0
  1840. DATA 2,0
  1841. DATA 2,0
  1842.  
  1843. IF n > 0 THEN
  1844.    IF holdwater(n) = 2 THEN
  1845.       CALL ListBottles(c1(),a)
  1846.       IF a = 0 THEN PRINT"You don't have anything to hold the water.":RETURN
  1847.       IF a > 1 THEN
  1848.          PRINT"Put the water in what?
  1849.          v=7:v$="put":p=1:p$="in"
  1850.          ask=1
  1851.          RETURN
  1852.       END IF
  1853.       CALL Alias("fill",26,c1(0),6,(n)):GOSUB Fill
  1854.       GOSUB RestoreCommand
  1855.       RETURN
  1856.    END IF
  1857. END IF
  1858. IF n < 0 THEN GOSUB Cannot:RETURN
  1859. IF immobile(n) THEN GOSUB Absurd:RETURN
  1860. IF lo(n) = 1 AND par(n) = 1 THEN PRINT"You already have "nn$(0)"!":RETURN
  1861.  
  1862. IF totw(n) > maxlift THEN PRINT FNcap$(nn$(0))" is too heavy to lift.":RETURN
  1863. IF totb(n) > maxgrab THEN PRINT FNcap$(nn$(0))" is too big to get a hold of.":RETURN
  1864. IF totw(n) + totw(1) > maxweight THEN PRINT"Your load is too heavy.":RETURN
  1865. IF totb(n) + bulk(1,1) > maxcap THEN PRINT"Your load is too bulky.":RETURN
  1866.  
  1867. CALL Remove(n)
  1868. CALL Insert(n,1,1)
  1869. PRINT"Taken."
  1870.  
  1871. RETURN
  1872.  
  1873. Drop:
  1874. DATA 1,0,0
  1875. DATA 0,0
  1876. DATA 1,0
  1877. DATA 2,1
  1878.  
  1879. IF n < 0 THEN GOSUB Cannot:RETURN
  1880. IF immobile(n) THEN GOSUB Cannot:RETURN
  1881. IF lo(n) <> 1 THEN CALL DontHave(nn$(0)):RETURN
  1882. CALL Avail(n,ava,0)
  1883. IF ava = 0 THEN
  1884.    CALL CantGetAt(nn$(0)):RETURN
  1885. ELSEIF ava = -1 THEN
  1886.    PRINT"You can't get "nn$(0)" out.":RETURN
  1887. END IF
  1888.  
  1889. IF holdwater(n) = 2 THEN
  1890.    IF par(n) = 0 THEN
  1891.       PRINT"Something's wrong here.
  1892.    ELSE
  1893.       CALL Alias("pour out",25,(par(n)),0,0):GOSUB Empty
  1894.       GOSUB RestoreCommand
  1895.       RETURN
  1896.    END IF
  1897. ELSE
  1898.    CALL Remove(n)
  1899.    CALL Insert(n,-l,0)
  1900.    worn(n) = 0
  1901.    PRINT"Dropped.
  1902. END IF
  1903.  
  1904. RETURN
  1905.  
  1906. Inventory:
  1907. DATA 0,0,0
  1908. DATA 0,0
  1909. DATA 0,0
  1910. DATA 0,0
  1911.  
  1912. IF sat>0 THEN PRINT"(you are sitting on the "word$(sat)".)
  1913. IF sat<0 THEN PRINT"(you are lying on the "word$(-sat)".)
  1914. CALL Contents(1,0,0)
  1915. IF first(1,1) = 0 THEN PRINT"You are carrying nothing.
  1916.  
  1917. RETURN
  1918.  
  1919. Examine:
  1920. DATA 1,0,0
  1921. DATA 0,0
  1922. DATA 0,0
  1923. DATA 2,0
  1924.  
  1925. IF n = -20 THEN GOSUB Inventory:RETURN
  1926. IF n < 0 OR long$(n) = "" THEN
  1927.    PRINT"You see nothing unusual about "nn$(0)".":RETURN
  1928. END IF
  1929. PRINT long$(n)
  1930. IF openable(n) THEN
  1931.    IF closed(n) THEN
  1932.       PRINT FNcap$(nn$(0))" is closed.
  1933.    ELSE
  1934.       PRINT FNcap$(nn$(0))" is open.
  1935.    END IF
  1936. END IF
  1937. IF folded(n) THEN PRINT FNcap$(nn$(0))" is "fold$(folded(n))".
  1938. IF n = 7 AND lampon = 1 THEN PRINT"The lamp is on.
  1939. CALL Contents(n,0,1) '*** List what's related to it, if anything
  1940.    
  1941. RETURN
  1942.  
  1943. go:
  1944. DATA 0,0,0
  1945. DATA 0,0
  1946. DATA 0,0
  1947. DATA 1,0
  1948.  
  1949. IF n = 0 THEN PRINT"Which way do you want to "v$"?":ask = 1:RETURN
  1950. IF n > 0 THEN GOSUB Absurd:RETURN
  1951.  
  1952. nl = map(l,-n-1)
  1953. IF nl < 0 THEN ' Map conditional
  1954.    i = -nl
  1955.    CALL EvalCond(mcond(0,i),mcond(1,i),mcond(2,i),true)
  1956.    IF true THEN
  1957.       nl = mcond(3,i)
  1958.    ELSE
  1959.       IF mmes$(i) <> "" THEN PRINT mmes$(i)
  1960.       nl = mcond(4,i)
  1961.       IF nl = l THEN RETURN
  1962.       IF mmes$(i) <> "" THEN PRINT
  1963.    END IF
  1964. END IF
  1965.  
  1966. ol = l:l = nl
  1967. GOTO Look
  1968.  
  1969. Place:
  1970. DATA 2,2,1
  1971. DATA 1,0
  1972. DATA 1,0
  1973. DATA 2,1
  1974.  
  1975. mode = p - 1
  1976.  
  1977. IF mode = 1 THEN GOTO Wrap
  1978. IF n > 0 THEN
  1979.    IF holdwater(n) = 2 AND holdwater(o) = 1 THEN
  1980.       CALL Alias("fill",26,(n(1)),6,(n(0))):GOSUB Fill
  1981.       GOSUB RestoreCommand
  1982.       RETURN
  1983.    END IF
  1984. END IF
  1985. IF n < 0 OR o < 0 THEN GOSUB Cannot:RETURN
  1986. IF immobile(n) THEN GOSUB Absurd:RETURN
  1987. IF cap(mode,o) = 0 THEN GOSUB Cannot:RETURN
  1988. IF mode = 0 THEN
  1989.    IF holdwater(n) = 2 THEN PRINT FNcap$(nn$(1))" won't hold water.":RETURN
  1990.    IF holdwater(n) = 0 THEN
  1991.       IF holdwater(first(0,o))=2 THEN
  1992.          PRINT"You can't put anything in "nn$(1)", there's water in it.
  1993.          RETURN
  1994.       END IF
  1995.    END IF
  1996.    f = 0:IF folded(o) THEN f = 1
  1997.    IF (openable(o) <> 0 AND closed(o) <> 0) OR f = 1 THEN 'try to open o
  1998.       PRINT"(opening "nn$(1)" first):
  1999.       CALL Alias("open",8,(n(1)),0,0):GOSUB OpenIt
  2000.       GOSUB RestoreCommand
  2001.       IF (openable(o)<>0 AND closed(o)<>0) OR folded(o)<>0 THEN RETURN
  2002.       PRINT"(then, putting "nn$(0)" "p$" "nn$(1)"): ";
  2003.       IF f THEN mode=2:p$="on"
  2004.    END IF
  2005. END IF
  2006. IF totb(n) > opening(mode,o) THEN
  2007.    PRINT FNcap$(nn$(0))" won't fit "p$" "nn$(1)".
  2008.    RETURN
  2009. END IF
  2010. IF totb(n) + bulk(mode,o) > cap(mode,o) THEN
  2011.    PRINT FNcap$(nn$(0))" won't fit; there's too much already "p$" "nn$(1)".
  2012.    RETURN
  2013. END IF
  2014. IF n = o THEN GOSUB Cannot:RETURN
  2015. ' Can't put stuff in clothing that you're wearing on your head (e.g. hats)
  2016. IF mode = 0 AND (worn(o) AND 2) <> 0 THEN
  2017.    PRINT"You can't put anything in "nn$(1)"; you're wearing it.":RETURN
  2018. END IF
  2019. IF rel(n) = mode AND par(n) = o THEN
  2020.    PRINT FNcap$(nn$(0))" is already "p$" "nn$(1)"!":RETURN
  2021. END IF
  2022.  
  2023. CALL Inside(o,n,ins,rel) 'Don't want to make n a descendant of itself
  2024. IF ins THEN PRINT"But "nn$(1)" is "prepn$(rel + 1)" "nn$(0)"!":RETURN
  2025.  
  2026. CALL Remove(n)
  2027. CALL Insert(n,o,mode)
  2028. worn(n) = 0
  2029.  
  2030. IF mode = 0 AND first(2,n) <> 0 THEN
  2031.    PRINT"Done, but everything that was on top of "nn$(0)" falls off inside
  2032.    PRINT nn$(1)".
  2033.    CALL Tumble(n)
  2034. ELSE
  2035.    PRINT"Done.
  2036. END IF
  2037.  
  2038. RETURN
  2039.  
  2040. OpenIt:
  2041. DATA 2,0,0
  2042. DATA 0,0
  2043. DATA 0,0
  2044. DATA 2,0
  2045.  
  2046. IF n < 0 THEN GOSUB Absurd:RETURN
  2047. IF folded(n) THEN GOTO UnWrap
  2048. IF openable(n) = 0 THEN GOSUB Cannot:RETURN
  2049. IF locked(n) THEN
  2050.    PRINT"(trying to unlock "nn$(0)" first)
  2051.    CALL Alias("unlock",11,(n(0)),0,0):GOSUB Unlock
  2052.    GOSUB RestoreCommand
  2053.    IF locked(n) THEN RETURN
  2054.    PRINT"(then, proceeding . . .)
  2055. END IF
  2056. IF closed(n) = 0 THEN PRINT FNcap$(nn$(0))" is already open.":RETURN
  2057. closed(n) = 0
  2058. IF first(0,n) <> 0 AND (opaque(0,n) <> 0) THEN
  2059.    PRINT"Opening "nn$(0)" reveals:
  2060.    CALL Contents(n,0,2)
  2061. ELSE
  2062.    PRINT FNcap$(nn$(0))" is now open.
  2063. END IF
  2064.  
  2065. RETURN
  2066.  
  2067. CloseIt:
  2068. DATA 2,0,0
  2069. DATA 0,0
  2070. DATA 0,0
  2071. DATA 2,0
  2072.  
  2073. IF n < 0 THEN GOSUB Absurd:RETURN
  2074. IF openable(n) = 0 THEN
  2075.    IF foldable(n) THEN GOTO Wrap ELSE GOSUB Cannot:RETURN
  2076. END IF
  2077. IF closed(n) THEN PRINT FNcap$(nn$(0))" is already closed.":RETURN
  2078.  
  2079. closed(n) = 1
  2080. PRINT FNcap$(nn$(0))" is now closed.
  2081.  
  2082. RETURN
  2083.  
  2084. Lock:
  2085. DATA 2,0,0
  2086. DATA 0,0
  2087. DATA 0,0
  2088. DATA 2,0
  2089.  
  2090. IF n < 0 THEN GOSUB Absurd:RETURN
  2091. PRINT"Don't know how to lock that.
  2092.  
  2093. RETURN
  2094.  
  2095. Unlock:
  2096. DATA 2,0,0
  2097. DATA 0,0
  2098. DATA 0,0
  2099. DATA 2,0
  2100.  
  2101. IF n < 0 THEN GOSUB Absurd:RETURN
  2102. PRINT"Don't know how to unlock that.
  2103.  
  2104. RETURN
  2105.  
  2106. TurnOn:
  2107. DATA 2,0,0
  2108. DATA 0,0
  2109. DATA 0,0
  2110. DATA 2,0
  2111.  
  2112. IF n < 0 THEN GOSUB Absurd:RETURN
  2113. IF n <> lamp THEN GOSUB Cannot:RETURN
  2114.  
  2115. IF flag(lampon) THEN PRINT FNcap$(nn$(0))" is already on.":RETURN
  2116. flag(lampon) = 1
  2117. PRINT FNcap$(nn$(0))" is now on.
  2118.  
  2119. RETURN
  2120.  
  2121. TurnOff:
  2122. DATA 2,0,0
  2123. DATA 0,0
  2124. DATA 0,0
  2125. DATA 2,0
  2126.  
  2127. IF n < 0 THEN GOSUB Absurd:RETURN
  2128. IF n <> lamp THEN GOSUB Cannot:RETURN
  2129.  
  2130. IF flag(lampon) = 0 THEN PRINT FNcap$(nn$(0))" is already off.":RETURN
  2131. flag(lampon) = 0
  2132. PRINT FNcap$(nn$(0))" is now off.
  2133.  
  2134. RETURN
  2135.  
  2136. Wordy:
  2137. DATA 0,0,0
  2138. DATA 0,0
  2139. DATA 0,0
  2140. DATA 0,0
  2141.  
  2142. flag(verbose) = 1
  2143.  
  2144. PRINT"I shall use long descriptions.
  2145. RETURN
  2146.  
  2147. Brief:
  2148. DATA 0,0,0
  2149. DATA 0,0
  2150. DATA 0,0
  2151. DATA 0,0
  2152.  
  2153. flag(verbose) = 0
  2154.  
  2155. PRINT"Brief descriptions.
  2156. RETURN
  2157.  
  2158. Superbrief:
  2159. DATA 0,0,0
  2160. DATA 0,0
  2161. DATA 0,0
  2162. DATA 0,0
  2163.  
  2164. flag(verbose) = -1
  2165.  
  2166. PRINT"Superbrief.
  2167. RETURN
  2168.  
  2169. SaveGame:
  2170. DATA 0,0,0
  2171. DATA 0,0
  2172. DATA 0,0
  2173. DATA 2,0
  2174.  
  2175. LINE INPUT"Save to file? ";file$
  2176. ON ERROR GOTO Saverr
  2177. cantopen = 0
  2178. 1000 OPEN file$ FOR OUTPUT AS 1
  2179. 1010 PRINT#1, dataformat$ ' Version number to verify format (see Initialize:)
  2180.  
  2181. ' Write out globals
  2182. PRINT#1, "GLOBAL"
  2183. WRITE#1, t,l,ol,maxcap,maxweight,maxgrab,maxlift,fat,warnthat
  2184.  
  2185. ' Write out flags
  2186. PRINT#1, "FLAGS"
  2187. WRITE#1, nflag
  2188. FOR i = 0 TO nflag
  2189.    WRITE#1, flag(i)
  2190. NEXT
  2191.  
  2192. ' Write out objects
  2193. PRINT#1, "OBJS"
  2194. WRITE#1, nobj,mrel
  2195. FOR i = 0 TO nobj
  2196.    WRITE#1, lo(i),par(i),rel(i)
  2197.    FOR j = 0 TO mrel
  2198.       PRINT#1, first(j,i)
  2199.    NEXT
  2200.    FOR j = 0 TO mrel
  2201.       PRINT#1, last(j,i)
  2202.    NEXT
  2203.    WRITE#1, left(i),right(i),size(i),closed(i),folded(i),locked(i),worn(i)
  2204.    WRITE#1, totw(i),totb(i)
  2205.    FOR j = 0 TO mrel
  2206.       PRINT#1, bulk(j,i)
  2207.    NEXT
  2208. NEXT i
  2209.  
  2210. ' Write out locations
  2211. PRINT#1, "LOCS"
  2212. PRINT#1, nloc
  2213. FOR i = 0 TO nloc
  2214.    WRITE#1, Lfirst(i),Llast(i),Lon(i)
  2215. NEXT i
  2216.  
  2217. ' Write out flag conditionals
  2218. PRINT#1, "FLAGCONDS"
  2219. PRINT #1,nfcond
  2220. FOR i = 0 TO nfcond
  2221.    PRINT#1, fcond(fseen,i)
  2222. NEXT
  2223.  
  2224. ' End marker
  2225. PRINT#1, "END"
  2226.  
  2227. PRINT:PRINT"Done.
  2228. EndSave:
  2229. ON ERROR GOTO 0
  2230. IF cantopen = 0 THEN CLOSE 1
  2231. RETURN
  2232.  
  2233. Saverr:
  2234. IF ERL = 1000 THEN
  2235.    cantopen = 1
  2236.    PRINT"Can't open'"file$"'!
  2237. ELSE
  2238.    PRINT"Disk error while saving game.  Aborting save.
  2239. END IF
  2240. RESUME EndSave
  2241.  
  2242. LoadGame:
  2243. DATA 0,0,0
  2244. DATA 0,0
  2245. DATA 0,0
  2246. DATA 0,0
  2247.  
  2248. LINE INPUT"Enter name of saved game: ";file$
  2249. ON ERROR GOTO Loaderr
  2250. cantopen = 0:okay = 0
  2251. 2000 OPEN file$ FOR INPUT AS 1
  2252. 2010 INPUT#1, a$
  2253. IF a$ <> dataformat$ THEN AbortLoad
  2254.  
  2255. ' Load constants
  2256. INPUT#1, a$:IF a$ <> "GLOBAL" THEN AbortLoad
  2257. INPUT#1, t,l,ol,maxcap,maxweight,maxgrab,maxlift,fat,warnthat
  2258.  
  2259. ' Load flags
  2260. INPUT#1, a$:IF a$ <> "FLAGS" THEN AbortLoad
  2261. INPUT#1, nflag
  2262. FOR i = 0 TO nflag
  2263.    INPUT#1, flag(i)
  2264. NEXT
  2265.  
  2266. ' Load objects
  2267. INPUT#1, a$:IF a$ <> "OBJS" THEN AbortLoad
  2268. INPUT#1, nobj,mrel
  2269. FOR i = 0 TO nobj
  2270.    INPUT#1, lo(i),par(i),rel(i)
  2271.    FOR j = 0 TO mrel
  2272.       INPUT#1, first(j,i)
  2273.    NEXT
  2274.    FOR j = 0 TO mrel
  2275.       INPUT#1, last(j,i)
  2276.    NEXT
  2277.    INPUT#1, left(i),right(i),size(i),closed(i),folded(i),locked(i),worn(i)
  2278.    INPUT#1, totw(i),totb(i)
  2279.    FOR j = 0 TO mrel
  2280.       INPUT#1, bulk(j,i)
  2281.    NEXT
  2282. NEXT i
  2283.  
  2284. ' Load locations
  2285. INPUT#1, a$:IF a$ <> "LOCS" THEN AbortLoad
  2286. INPUT#1, nloc
  2287. FOR i = 0 TO nloc
  2288.    INPUT#1, Lfirst(i),Llast(i),Lon(i)
  2289. NEXT i
  2290.  
  2291. ' Load flag conditionals info
  2292. INPUT#1, a$:IF a$ <> "FLAGCONDS" THEN AbortLoad
  2293. INPUT#1, nfcond
  2294. FOR i = 0 TO nfcond
  2295.    INPUT#1, fcond(fseen,i)
  2296. NEXT
  2297.  
  2298. PRINT:PRINT"Done.":okay = 1
  2299. EndLoad:
  2300. ON ERROR GOTO 0
  2301. IF cantopen = 0 THEN CLOSE 1
  2302. IF okay THEN Look
  2303. RETURN
  2304.  
  2305. AbortLoad:
  2306. PRINT"Saved game is in wrong format (shouldn't have read '"a$"').
  2307. PRINT"Aborting.
  2308. GOTO EndLoad
  2309.  
  2310. Loaderr:
  2311. IF ERL = 2000 THEN
  2312.    cantopen = 1
  2313.    PRINT"Can't open'"file$"'!
  2314. ELSE
  2315.    PRINT"Disk error while loading game.
  2316. END IF
  2317. RESUME EndLoad
  2318.  
  2319. PutOn:
  2320. DATA 2,0,0
  2321. DATA 1,0
  2322. DATA 0,0
  2323. DATA 2,0
  2324.  
  2325. IF n < 0 THEN GOSUB Absurd:RETURN
  2326. IF wearable(n) = 0 THEN GOSUB Cannot:RETURN
  2327. IF worn(n) <> 0 THEN PRINT"You're already wearing "nn$(0)"!":RETURN
  2328. worn(n) = wearable(n)
  2329. CALL Remove(n)
  2330. CALL Insert(n,1,0)
  2331. PRINT"You are now wearing "nn$(0)".
  2332.  
  2333. RETURN
  2334.  
  2335. TakeOff:
  2336. DATA 2,0,0
  2337. DATA 1,0
  2338. DATA 1,0
  2339. DATA 2,0
  2340.  
  2341. IF n < 0 THEN GOSUB Absurd:RETURN
  2342. IF wearable(n) = 0 THEN GOSUB Absurd:RETURN
  2343. IF worn(n) = 0 THEN PRINT"You're not wearing "nn$(0)".":RETURN
  2344. dropflag = 0
  2345. IF totb(n) + totb(1) > maxcap OR totw(n) + totb(1) > maxweight THEN
  2346.    PRINT"You're carrying too much already, you'll have to drop something first.
  2347.    RETURN
  2348. END IF
  2349. IF totw(n) > maxlift OR totb(n) > maxgrab THEN
  2350.    PRINT"You take off "nn$(0)", but you fumble with it and it falls.
  2351.    worn(n) = 0
  2352.    PRINT FNcap$(nn$(0))": ";
  2353.    GOTO Drop
  2354. END IF
  2355.  
  2356. worn(n) = 0
  2357. CALL Remove(n)
  2358. CALL Insert(n,1,1)
  2359. PRINT"You are now no longer wearing "nn$(0)".
  2360.  
  2361. RETURN
  2362.  
  2363. Wrap:
  2364. DATA 2,0,0
  2365. DATA 0,0
  2366. DATA 0,0
  2367. DATA 2,1
  2368.  
  2369. IF n < 0 OR o < 0 THEN GOSUB Absurd:RETURN
  2370. IF o <> 0 AND p <> 1 AND p <> 3 AND p <> 6 THEN GOSUB Absurd:RETURN
  2371. IF o <> 0 THEN
  2372.    CALL Avail(o,ava,0)
  2373.    IF ava = 0 THEN CALL CantGetAt(nn$(1)):RETURN
  2374. END IF
  2375. IF o = 0 THEN o = n:n(1) = n(0):n = 0:n(0) = 0:nn$(1) = nn$(0)
  2376. IF foldable(o) = 0 OR cap(1,o) = 0 THEN GOSUB Absurd:RETURN
  2377. IF folded(o) THEN
  2378.    PRINT FNcap$(nn$(1))" is already "fold$(folded(o))".
  2379.    RETURN
  2380. END IF
  2381. IF bulk(0,o) THEN
  2382.    PRINT"You can't wrap anything with "nn$(1)"; there's something in it.
  2383.    RETURN
  2384. END IF
  2385. IF worn(o) THEN
  2386.    PRINT"(taking off "nn$(1)" first):
  2387.    CALL Alias("take off",20,(n(1)),0,0):GOSUB TakeOff
  2388.    GOSUB RestoreCommand
  2389.    IF (worn(n)) THEN RETURN
  2390.    PRINT"(then, proceeding . . .)
  2391. END IF
  2392. IF n = 0 THEN
  2393.    IF bulk(2,o) > cap(1,o) THEN
  2394.       PRINT FNcap$(nn$(1))" isn't big enough to wrap what's on it.
  2395.       RETURN
  2396.    END IF
  2397.    CALL RemList(o,2,head)
  2398.    CALL Concat(head,o,1)
  2399. ELSE
  2400.    IF totb(n) > cap(1,o) THEN
  2401.       PRINT FNcap$(nn$(1))" isn't big enough to wrap "nn$(0)".
  2402.       RETURN
  2403.    END IF
  2404.    CALL Remove(n)
  2405.    CALL Insert(n,o,1)
  2406. END IF
  2407. folded(o) = foldable(o)
  2408. PRINT"Done.
  2409. RETURN
  2410.  
  2411. UnWrap:
  2412. DATA 2,0,0
  2413. DATA 0,0
  2414. DATA 0,0
  2415. DATA 2,0
  2416.  
  2417. IF n < 0 THEN GOSUB Absurd:RETURN
  2418. IF foldable(n) = 0 THEN GOSUB Absurd:RETURN
  2419. IF folded(n) = 0 THEN PRINT FNcap$(nn$(0))" isn't "fold$(foldable(n))".":RETURN
  2420. folded(n) = 0
  2421. tumb = (bulk(1,n) > cap(2,n))
  2422. CALL RemList(n,1,head)
  2423. IF tumb THEN
  2424.    PRINT"When you open "nn$(0)", everything in it falls out.
  2425.    CALL Concat(head,-l,0)
  2426. ELSE
  2427.    IF head <> 0 THEN
  2428.       PRINT"Opening "nn$(0)" reveals:
  2429.       CALL Contents(head,3,0)
  2430.       CALL Concat(head,n,2)
  2431.    ELSE
  2432.       PRINT"Opened.
  2433.    END IF
  2434. END IF
  2435. RETURN
  2436.  
  2437. Restart:
  2438. DATA 0,0,0
  2439. DATA 0,0
  2440. DATA 0,0
  2441. DATA 0,0
  2442.  
  2443. LINE INPUT"Start over from the beginning? (Are you sure?) >";a$
  2444. IF LEFT$(a$,1) = "y" THEN RUN
  2445.  
  2446. PRINT:PRINT"Okay.
  2447. RETURN
  2448.  
  2449. Again:
  2450. DATA 0,0,0
  2451. DATA 0,0
  2452. DATA 0,0
  2453. DATA 0,0
  2454.  
  2455. cmd$ = ocmd$:ask = 3:RETURN
  2456.  
  2457. Empty:
  2458. DATA 2,0,1
  2459. DATA 1,0
  2460. DATA 1,2
  2461. DATA 2,1
  2462.  
  2463. IF n<0 OR o<0 THEN GOSUB Absurd:RETURN
  2464. IF p THEN IF p<>1 THEN GOSUB Cannot:RETURN
  2465. IF holdwater(n)=2 THEN c=n-1 ELSE c=n
  2466. IF holdwater(c)=0 THEN
  2467.    ' Place test particle inside n, to see if
  2468.    ' stuff in there is visible or not
  2469.    lo(0) = l:par(0) = c:rel(0) = 0
  2470.    CALL Visible(0,vis,0)
  2471.    IF vis THEN
  2472. Empty1:
  2473.       mlnoun(0) = 0
  2474.       CALL ListSib(first(0,c),mnoun(),mlnoun(),0)
  2475.       IF mlnoun(0) = 0 THEN
  2476.          PRINT FNcap$(nn$(0))" is empty.
  2477.          RETURN
  2478.       END IF
  2479.    ELSE
  2480.       IF closed(c) THEN
  2481.          PRINT"(opening "nn$(0)" first): ";
  2482.          CALL Alias("open",8,c,0,0):GOSUB OpenIt
  2483.          GOSUB RestoreCommand
  2484.          lo(0)=l:par(0)=c:rel(0)=0
  2485.          CALL Visible(0,vis,0)
  2486.          IF vis=0 THEN RETURN ELSE GOTO Empty1
  2487.       ELSE
  2488.          GOSUB Mystery:GOTO NewCommand
  2489.       END IF
  2490.    END IF
  2491.    FOR emptyi=1 TO mlnoun(0)
  2492.       PRINT"the "word$(mnoun(0,emptyi))": ";
  2493.       CALL Alias("drop",3,mnoun(0,emptyi),0,0):GOSUB Drop
  2494.       GOSUB RestoreCommand
  2495.    NEXT
  2496.    RETURN
  2497. END IF
  2498. IF bulk(0,c) = 0 THEN PRINT"The "word$(c)" is empty.":RETURN
  2499. IF par(c)<>1 THEN
  2500.    PRINT"(taking out the "word$(c)" first): ";
  2501.    CALL Alias("take out",2,c,0,0):GOSUB Take
  2502.    GOSUB RestoreCommand
  2503.    IF par(c)<>1 THEN RETURN
  2504. END IF
  2505. IF closed(c) THEN
  2506.    PRINT"(opening the "word$(c)" first):
  2507.    CALL Alias("open",8,c,0,0):GOSUB OpenIt
  2508.    GOSUB RestoreCommand
  2509.    IF closed(c) THEN RETURN
  2510. END IF
  2511.  
  2512. IF o THEN
  2513.    IF holdwater(o) = 2 THEN d=o-1 ELSE d=o
  2514.    amt = bulk(0,c)
  2515.    CALL Fill(d,amt)
  2516.    CALL Fill(c,-amt)
  2517.    IF bulk(0,c)<>0 THEN PRINT"You fill up the "word$(d)" with some water from the "word$(c)".":RETURN
  2518.    PRINT"You empty the "word$(c)" completely into the "word$(d)".
  2519. ELSE
  2520.    CALL Empty(c)
  2521.    PRINT"The water pours out and evaporates.
  2522. END IF
  2523. RETURN
  2524.  
  2525. Fill:
  2526. DATA 2,2,6
  2527. DATA 1,0
  2528. DATA 1,2
  2529. DATA 2,1
  2530.  
  2531. IF n<0 OR (p<>6 AND p<>7) THEN GOSUB Absurd:RETURN
  2532. IF holdwater(o) = 1 THEN w=o+1 ELSE w=o
  2533. IF holdwater(n)<>1 OR holdwater(w)<>2 THEN
  2534.    CALL Alias("put",7,w,1,n):GOSUB Place
  2535.    GOSUB RestoreCommand
  2536.    RETURN
  2537. END IF
  2538. IF size(w)=0 THEN PRINT"The "word$(w-1)" is empty.":RETURN
  2539. amt=size(w):max=amt
  2540. CALL Fill(n,amt)
  2541. IF amt<max THEN
  2542.    IF amt=0 THEN
  2543.       PRINT FNcap$(nn$(0))" is already full.":RETURN
  2544.    ELSE
  2545.       PRINT"You fill up "nn$(0)" with some water from the "word$(w-1)".
  2546.    END IF
  2547. END IF
  2548. CALL Fill(w-1,-amt)
  2549. RETURN
  2550.  
  2551. Eat:
  2552. DATA 2,0,0
  2553. DATA 1,0
  2554. DATA 0,0
  2555. DATA 2,0
  2556.  
  2557. IF n<0 THEN GOSUB Absurd:RETURN
  2558. IF food(n) = 0 THEN GOSUB Cannot:RETURN
  2559.  
  2560. ' Please modify the code below if you want to handle food more realistically
  2561. CALL Remove(n) ' The food just disappears
  2562. ON RND(1) * 3 GOTO Eat1,Eat2
  2563. PRINT"Eaten.":RETURN
  2564. Eat1:
  2565. PRINT"Mmm, mmm, that was good!":RETURN
  2566. Eat2:
  2567. PRINT"Ugh, a little stale, but edible.
  2568. RETURN
  2569.  
  2570. Drink:
  2571. DATA 2,0,0
  2572. DATA 0,0
  2573. DATA 0,0
  2574. DATA 2,0
  2575.  
  2576. IF n<0 THEN GOSUB Absurd:RETURN
  2577.  
  2578. wat = -1
  2579. CALL Fill(n-1,wat)
  2580. IF wat = -1 THEN
  2581.    IF bulk(0,n-1) = 0 THEN
  2582.       PRINT "You drink all of "nn$(0)".
  2583.    ELSE
  2584.       PRINT"You drink some of "nn$(0)".
  2585.    END IF
  2586. ELSE
  2587.    PRINT"There's nothing to drink.
  2588. END IF
  2589. RETURN
  2590.  
  2591. Sit: ' This code handles both sitting and lying down
  2592. DATA 0,0,0
  2593. DATA 0,2
  2594. DATA 0,2
  2595. DATA 0,2
  2596.  
  2597. sitflag = 1
  2598.  
  2599. Sit1: ' The Lie: code jumps to here with sitflag = 3
  2600. IF o < 0 THEN GOSUB Absurd:RETURN
  2601. IF p <> 3 THEN GOSUB Cannot:RETURN
  2602. IF sat THEN
  2603.    IF sitflag = 1 THEN
  2604.       IF sat = o THEN
  2605.          PRINT"You're already sitting on "nn$(1)".
  2606.          RETURN
  2607.       END IF
  2608.    ELSE
  2609.       IF -sat = o THEN
  2610.          PRINT"You're already lying on "nn$(1)".
  2611.          RETURN
  2612.       END IF
  2613.    END IF
  2614.    IF ABS(sat) <> o THEN
  2615.       PRINT"(standing up first):
  2616.       CALL Alias("stand up",30,0,0,0):GOSUB Stand
  2617.       GOSUB RestoreCommand
  2618.       IF (sat) THEN RETURN
  2619.       PRINT"(then, proceeding . . .)
  2620.    END IF
  2621. END IF
  2622.  
  2623. IF cap(2,o) < fat * sitflag THEN
  2624.    PRINT FNcap$(nn$(1))" is too small for you to "v$" on.
  2625. ELSE
  2626.    IF soft(o) = 0 THEN
  2627.       PRINT FNcap$(nn$(1))" is very uncomfortable, but you "v$" on it anyway.
  2628.    ELSE
  2629.       PRINT"You "v$" on "nn$(1)".
  2630.       IF soft(o) = 2 THEN PRINT"It's very comfortable.
  2631.    END IF
  2632.    IF sitflag = 1 THEN sat = o ELSE sat = -o
  2633. END IF
  2634. RETURN
  2635.  
  2636. Stand:
  2637. DATA 0,0,0
  2638. DATA 0,0
  2639. DATA 0,0
  2640. DATA 0,0
  2641.  
  2642. IF sat = 0 THEN PRINT"You're already standing.":RETURN
  2643. sat = 0
  2644. PRINT"You get up.
  2645. RETURN
  2646.  
  2647. Lie:
  2648. DATA 0,0,0
  2649. DATA 0,2
  2650. DATA 0,2
  2651. DATA 0,2
  2652.  
  2653. sitflag = 3:GOSUB Sit1
  2654. RETURN
  2655.  
  2656. QuitGame:
  2657. DATA 0,0,0
  2658. DATA 0,0
  2659. DATA 0,0
  2660. DATA 2,0
  2661.  
  2662. IF n = 0 THEN n = -22
  2663. IF n <> -22 THEN GOSUB Absurd:RETURN
  2664.  
  2665. LINE INPUT"Quit the game? (Are you sure?) >";a$
  2666. IF LEFT$(a$,1) <> "y" THEN PRINT"Okay.":RETURN
  2667. LINE INPUT"Save the game first? ";a$
  2668. IF LEFT$(UCASE$(a$),1) = "Y" THEN GOSUB SaveGame
  2669.  
  2670. PRINT"Okay, bye!
  2671. END
  2672. RETURN ' In case the player does a "cont"
  2673.  
  2674. DrinkAll:
  2675. DATA 2,0,0
  2676. DATA 0,0
  2677. DATA 0,0
  2678. DATA 2,0
  2679.  
  2680. IF n<0 THEN GOSUB Absurd:RETURN
  2681.  
  2682. wat = -bulk(0,n-1)
  2683. CALL Fill(n-1,wat)
  2684. IF wat < 0 THEN
  2685.    PRINT "You drink all of "nn$(0)".
  2686. ELSE
  2687.    PRINT"There's nothing to drink.
  2688. END IF
  2689. RETURN
  2690.  
  2691. '*** Error detection marker
  2692. DATA "Z"
  2693.  
  2694. map:
  2695. ' Location 1 is reserved to hold object 1, which holds everything the
  2696. ' player is carrying (in his/her hands)
  2697. '
  2698. ' The data format is as follows:
  2699. '
  2700. '   DATA loc, N,NE,E,SE,S,SW,W,NW,U,D, light, lighton?
  2701. '
  2702. ' (OPTIONAL:
  2703. '   DATA flag1,comp1,value1,loctrue1,locfalse1,"falsemessage"
  2704. '   DATA flag2,comp2,value2,loctrue2,locfalse2,"falsemessage"
  2705. '    . . . and so on, one line for each map conditional here)
  2706. '
  2707. '   DATA short description
  2708. '   DATA long description line 1
  2709. '   DATA long description line 2
  2710. '   DATA  . . .
  2711. '   DATA long description last line
  2712. '   DATA ""
  2713. '
  2714. ' (OPTIONAL:
  2715. '   DATA flagnum,comp,value,verbose
  2716. '   DATA description lines
  2717. '   DATA ""
  2718. '    . . . repeat as often as desired)
  2719. '
  2720. '   DATA -1,0,0,0 ' End of this description
  2721. '
  2722. ' Loc is the location number, and is used as a checking mechanism only;
  2723. ' unlike elsewhere, the map MUST be in sequential order, starting with 2.
  2724. ' Location 1 is reserved to hold "object" number 1 which contains
  2725. ' everything the player is carrying (see Objects:).
  2726. '
  2727. ' The following numbers are direction codes for each direction.
  2728. '
  2729. ' The light flag is 0 if there is no light source (cave), 1 if there is
  2730. ' natural light, and 2 if there is electric light (switchable on/off).
  2731. '
  2732. ' Lighton? is usually used to flag whether or not the electric light
  2733. ' is on or off.  If this flag is non-zero, the value returned by CheckLight()
  2734. ' will be this value.
  2735. '
  2736. ' Then come the map conditional DATA statements, the short and long
  2737. ' descriptions, the conditional descriptions, then the 0,0,0,0 end marker.
  2738. '
  2739. ' DEFINITIONS:
  2740. '
  2741. ' CONDITIONAL:
  2742. '    A "conditional" is a triplet "flagnum,comp,value" which
  2743. ' is evaluated as TRUE when flag(flagnum) < value, flag(flagnum) = value,
  2744. ' flag(flagnum) > value, or flag(flagnum) <> value, depending on whether
  2745. ' comp is -1, 0, 1, or 2, respectively.  (See Calc:EvalCond().  See
  2746. ' also Flags:)
  2747. '
  2748. ' DIRECTION CODES:
  2749. '    If positive, these are simply location numbers.
  2750. ' (If the first number is -99, this is a "forced move" or a "bounceback"
  2751. ' location; the codes are interpreted differently; see below for details.)
  2752. '
  2753. ' MAP CONDITIONAL:
  2754. '    If the direction code is a negative number (from -10 to -1), the code
  2755. ' is an index to a "map conditional".  -1 refers to the first map
  2756. ' conditional in the location, -2 to the second, etc.  For each map
  2757. ' conditional in a location, there must be a DATA statement: (following
  2758. ' the direction and status codes)
  2759. '
  2760. '    DATA flagnum,comp,value,trueloc,falseloc,"falsemessage"
  2761. '         ^--(conditional)--^
  2762. '
  2763. ' If the conditional is true, the player lands in trueloc, no questions
  2764. ' asked.  If false, the program prints "falsemessage" and then a blank line
  2765. ' (if "falsemessage" is NOT null), and then the player goes to falseloc
  2766. ' (which can be 0, which ends up with a "Can't go that way.")
  2767. '
  2768. ' For example,
  2769. '   DATA 54, 41,0,3,0,27,0,-1,0,0,0, 0,0,0
  2770. '   DATA 12,0,1,97,54,"The snake blocks your way."
  2771. ' means, this is location 54.  You can go north to 41, east to 3,
  2772. ' and south to 27.  If flag 12 is equal to 1, you can go west to
  2773. ' location 97; otherwise "The snake blocks your way" and you stay
  2774. ' in location 54.
  2775. '
  2776. ' FORCED MOVE LOCATIONS, BOUNCEBACK:
  2777. '    If the location number for "north" is -99, then the location
  2778. ' is a "forced move" location; the player simply gets to see the
  2779. ' description and then is moved immediately to a new location:
  2780. '
  2781. '    DATA loc, -99,flagnum,cond,value,loctrue,locfalse,0,0,0,0, 0,0,0
  2782. '                  ^---conditional---^
  2783. '
  2784. '    The player is immediately moved to loctrue if the conditional is
  2785. ' true, and locfalse if false.  If either locations are -99, the player
  2786. ' is simply "bounced back" to his/her former location (combining this
  2787. ' with the map conditionals described above allows you to have
  2788. ' map conditionals that print out arbitrarily long messages).  Note:
  2789. ' since flag zero is set to a constant value of 1, you can always
  2790. ' force a specific move or bounceback by testing flag zero for value 1.
  2791. '
  2792. ' DESCRIPTIONS:
  2793. '    Finally, you have the short description, which is a one-line
  2794. ' "title" for the room.  Then follows the long description, which ends
  2795. ' with a NULL string.  If the first line is a null string, NO description
  2796. ' is printed (except possibly for the conditional descriptions, below.)
  2797. ' Normally the long description is only printed when the player
  2798. ' encounters a location for the first time, when flag(verbose) = 1,
  2799. ' or when the player says "look".  At other times only the short description
  2800. ' is printed.
  2801. '    In addition, if the short description is simply a space " ", the
  2802. ' full description will always be printed.
  2803. '    Any line in the long description that is just a single "z" will
  2804. ' cause the "press any key to continue" message.
  2805. '
  2806. ' CONDITIONAL DESCRIPTIONS: 
  2807. '
  2808. '     DATA flagnum,comp,value,verbosity
  2809. '          ^---conditional---^
  2810. '     DATA "First line"
  2811. '         . . .
  2812. '     DATA "Last line"
  2813. '     DATA ""
  2814. '
  2815. '    If the conditional is true, and the "verbosity" condition is satisfied,
  2816. ' the description is printed.  If verbosity is 0, the description is printed
  2817. ' only if the long description (see above) is printed.  If 1, then
  2818. ' it doesn't matter whether or not the long description is printed.  If 2,
  2819. ' then the conditional description is printed only ONCE, but only when
  2820. ' the long description is printed, and if 3, the conditional is printed
  2821. ' only once, but irregardless of whether or not the long description is
  2822. ' printed as well.
  2823. '
  2824. '    Any line in the conditional description that is just a single "z"
  2825. ' will cause the "press any key to continue" message.
  2826. '
  2827. '    Finally, DATA -1,0,0,0 will mark the end of a description.
  2828.  
  2829. ' All the parameters below can be changed to suit your particular style
  2830. ' Maximum location number
  2831. DATA 100
  2832. ' Average number of lines of description per location
  2833. DATA 5
  2834. ' Maximum number of map conditionals
  2835. DATA 50
  2836. ' Maximum number of flag conditionals
  2837. DATA 50
  2838. ' Average number of lines of description per flag conditional
  2839. DATA 3
  2840.  
  2841. MapList:
  2842. ' Begin with location 2
  2843. ' -99 means forced move
  2844. ' "0,0,0" means test flag 0 to equal 0, which is ALWAYS TRUE, so
  2845. ' go to location 3 immediately
  2846. '   this v---v is the conditional (always true)
  2847. DATA 2, -99,0,0,0,3,0,0,0,0,0, 0,0
  2848. DATA "Welcome . . .
  2849. DATA " "
  2850. DATA "   You awaken to find yourself in a completely foreign
  2851. DATA "land, filled with creatures and peoples you have never even
  2852. DATA "imagined.  After wandering for some time, you come to a deserted
  2853. DATA "castle on a hilltop, overlooking the sea.  You climb up to the
  2854. DATA "tower and have a good night's sleep, unaware of the adventures
  2855. DATA "that lie ahead . . .
  2856. DATA " "
  2857. DATA "   You awake from a deep sleep, hoping to find yourself safe
  2858. DATA "at home, but, alas, you are still in the---
  2859. DATA "z"
  2860. DATA ""
  2861. DATA -1,0,0,0
  2862.  
  2863. ' Go down to location 4 --v
  2864. DATA 3, 0,0,0,0,0,0,0,0,0,4, 1,0
  2865. '         Natural lighting --^
  2866. DATA "Castle Tower
  2867. DATA "From here you can see the raging green ocean, stretching out
  2868. DATA "to the horizon to the north.  The tower itself is ravaged by
  2869. DATA "time, and the walls of the tower are crumbling and exposed.
  2870. DATA "A spiral stairway winds down the inside of the walls of this
  2871. DATA "round tower.
  2872. DATA ""
  2873. DATA -1,0,0,0
  2874.  
  2875. ' Two map conditionals here, indicated by "-1" and "-2"
  2876. ' West to location 8--v   v--Go up to location 3
  2877. DATA 4, 0,0,-1,0,-2,0,8,0,3,0, 1,0
  2878. '           Natural lighting --^
  2879. ' If flag 20 equals 1, go to location 6.  Otherwise go to 4, print "closed."
  2880. DATA 20,0,1,6,4,"The door is closed."
  2881. ' If flag 21 equals 1, go to location 7.  Otherwise print "Can't go that..."
  2882. DATA 21,0,1,7,0,""
  2883. DATA "Tower Base
  2884. DATA "This is a high-ceilinged room, some 25 feet, with the only light
  2885. DATA "coming through the doorway to the west and dimly from upstairs.
  2886. DATA "There is a heavy wooden door, about fifteen feet tall, in the
  2887. DATA "eastern wall.  The walls of made of finely-hewn stone, set with
  2888. DATA "a minimum of mortar, and are surprisingly well-preserved.
  2889. DATA "A spiral staircase winds up the perimeter.  The staircase was
  2890. DATA "cut from the very stone walls themselves.
  2891. DATA ""
  2892. ' On the first day, print this message once
  2893. ' (flag(4) is the day number, verbosity code 2 means print only once)
  2894. DATA 4,0,1,2
  2895. DATA "Here in the base of the tower you find evidence that the people
  2896. DATA "who built this castle were more highly technically advanced
  2897. DATA "than you originally thought: there are steel brackets mounted
  2898. DATA "in the walls.  Funny that you didn't recall seeing them last
  2899. DATA "night, but after all it was dark and you were tired and disoriented.
  2900. DATA ""
  2901. ' Secret passageway
  2902. ' If flag 21 equals 1, print the following description
  2903. DATA 21,0,1,0
  2904. DATA "A solid black rectangle, about the size of a door, hovers
  2905. DATA "as if attached to the southern wall.  It appears pitch black,
  2906. DATA "nevertheless a slight breeze emerges from it.
  2907. DATA ""
  2908. ' Continuation of long description
  2909. ' If flag 0 equals 0 (always true), and the long description was
  2910. ' printed (verbosity 0), print the following
  2911. DATA 0,0,0,0
  2912. DATA "You hear the surf pounding on the rocks in the distance.
  2913. DATA ""
  2914. DATA -1,0,0,0
  2915.  
  2916. ' Example of a bounceback location
  2917. ' -99 means forced move
  2918. ' If flag 0 equals 0 (always true), go to location -99, which means
  2919. ' "bounce back"
  2920. '      this v---v is the conditional (always true)
  2921. DATA 5, -99,0,0,0,-99,0,0,0,0,0, 0,0
  2922. DATA " "
  2923. DATA "There is a flash of intense blue light and you are blinded
  2924. DATA "for a moment before the air clears and you realize you have
  2925. DATA "been jolted back into the tower base by some sort of force field.
  2926. DATA ""
  2927. DATA -1,0,0,0
  2928.  
  2929. ' One map conditional, marked by "-1"
  2930. '       Going west --v checks map conditional 1 first
  2931. DATA 6, 0,0,0,0,0,0,-1,0,0,0, 0,0
  2932. '             Lamp lighting --^
  2933. ' Map conditional 1 (for this location)
  2934. ' if flag 20 equals 1, goto 4, otherwise stay in 6, print "door shut."
  2935. DATA 20,0,1,4,6,"The door is firmly shut.
  2936. DATA "Strange Grotto
  2937. DATA "This is more a hollowed-out cave than a room.  The walls are
  2938. DATA "simply made of soft dirt that seems to have been recently dug,
  2939. DATA "except for the stone wall to the west in which is embedded a
  2940. DATA "heavy wooden door.  The walls seem to be held together only by
  2941. DATA "a tightly woven net of roots which seem to ooze from everywhere
  2942. DATA "and appear almost as if they are moving.
  2943. DATA ""
  2944. ' If flag 20 equals 1, print the following
  2945. ' (verbosity code 0 means only print when the long description is also)
  2946. DATA 20,0,1,0
  2947. DATA "The door is ajar.",""
  2948. DATA -1,0,0,0
  2949.  
  2950. ' One map conditional here, marked by "-1"
  2951. ' If you go north, check map conditional 1 first
  2952. ' Otherwise, stay in location 7, no matter where you go
  2953. DATA 7, -1,7,7,7,7,7,7,7,7,7, 0,0
  2954. DATA 21,0,1,4,7,""
  2955. ' " " first means always print the long description
  2956. DATA " "
  2957. DATA "FLYING
  2958. DATA "You have a vision, that you are flying way above the clouds,
  2959. DATA "with nothing about you but the earth far below, a mountain range
  2960. DATA "to the east, and a bright afternoon sun.
  2961. DATA 21,0,1,0
  2962. DATA "A dark rectangle hovers in the air directly north of you.",""
  2963. DATA -1,0,0,0
  2964.  
  2965. ' Go east to location 3, west to location 5
  2966. DATA 8, 0,0,4,0,0,0,5,0,0,0, 0,0
  2967. DATA "Entry Hall
  2968. DATA "This is what was obviously once an entry hall.  The doorway to
  2969. DATA "the outside lies to the west.  A fountain, made from exquisite
  2970. DATA "marble, lies in the center of the room, and still contains water.
  2971. DATA ""
  2972. DATA -1,0,0,0
  2973.  
  2974. ' End marker
  2975. DATA 0
  2976.  
  2977. Flags:
  2978. ' The flag format is simple:
  2979. '
  2980. ' DATA flag,value,flag,value, . . .
  2981. '
  2982. ' Where flag is a flag number and value is its initial value.  If
  2983. ' not otherwise specified, the value is zero.
  2984. '
  2985. ' The first value is the maximum number of flags (mflag).
  2986. '
  2987. DATA 40
  2988.  
  2989. ' Note: the convention followed here is that flags 0-19 are "system"
  2990. ' flags, common to all adventures that use this kernal.  At the moment,
  2991. ' only flags 0-7 are being used.  Flags 20 and up are "adventure" flags,
  2992. ' which are set and reset by the individual program.  In the example
  2993. ' "adventure" given here, flags 20 and 21 are used.
  2994. '
  2995. ' This program segment is also called as a subroutine by Initialize:
  2996. ' to set various mnemonic variables to index the flag() array
  2997. '
  2998. ' Note: flag zero should never be changed from its value of zero
  2999. ' Flag zero is used as a constant value for flag conditionals
  3000. flag(0) = 0
  3001. ' Lamp on?
  3002. lamp = 2:lampon = 2 'lamp is object 2
  3003. DATA 2,1
  3004. ' Daytime? 2-moonlight, 3-twilight, 4-daytime
  3005. day = 3
  3006. DATA 3,4
  3007. ' Day number
  3008. date = 4
  3009. DATA 4,1
  3010. ' Time (aka "t") (See PostProcess:)
  3011. tim = 5
  3012. DATA 5,1
  3013. ' Detail level (see Wordy: Brief: and Superbrief:)
  3014. verbose = 6
  3015. DATA 6,0
  3016. ' Random (varies from 0 to 99) call RollDice to set this flag (Calc:)
  3017. ' Note: EvalCond() automatically calls RollDice if flag(random) is tested
  3018. random = 7
  3019. RANDOMIZE TIMER ' Seed generator with timer value
  3020. DATA 7,0
  3021. CALL RollDice
  3022.  
  3023. ' End marker
  3024. DATA 0
  3025. RETURN
  3026.  
  3027. Objects:
  3028. '
  3029. '  The list of objects is as follows:
  3030. '  data Number,prefix,word,adjectives,long description
  3031. '  data location,parent,relation
  3032. '  data size,weight,inopening,wrapopening,onopening,underopening
  3033. '  data containcapacity,wrapcapacity,surfacecapacity,undercapacity
  3034. '  data containopaque,wrapopaque,surfaceopaque,underopaque
  3035. '  data closed?,openable?,folded?,foldable?,locked?
  3036. '  data holdwater?,worn?,wearable?,soft?,food?,immobile?
  3037. '  data special 1,special 2,special 3
  3038. '
  3039. '  This information is placed in the following arrays, indexed by Number:
  3040. '
  3041. '  pre$(),word$(),adj$(),long$()
  3042. '  lo(),par(),rel()
  3043. '  { see below for first(rel,),last(rel,),left(), and right() }
  3044. '  size(),{see below for totw()},opening(rel,),cap(rel,),opaque(rel,)
  3045. '  closed(),openable(),folded(),foldable(),locked()
  3046. '  holdwater(),worn(),wearable(),soft(),food(),immobile()
  3047. '  special(0/1/2,)
  3048. '
  3049. '  More information is placed in the following arrays:
  3050. '  
  3051. '  totw(),totb(),bulk(rel,)
  3052. '
  3053. '  The Number identifies the object to the program.  You can delete and
  3054. '  add objects without changing these Numbers, and in fact the objects
  3055. '  can be listed in any order.
  3056. '
  3057. '  The prefix contains "a" or "an" and any modifiers to be used when
  3058. '  listing the object (as in Contents()). --> pre$()
  3059. '
  3060. '  Word is a single word describing the type of object. --> word$()
  3061. '
  3062. '  Adjectives are used by the program to ask the player to
  3063. '  distinguish one object from another. --> adj$()
  3064. '
  3065. '  The long description is for use when the player examines an
  3066. '  object. --> long$()
  3067. '
  3068. '  The location is the room number the object is in.  This is 0 if the
  3069. '  object does not exist, and 1 if the player is carrying it.  This means
  3070. '  actual room numbers start with the number 2. --> lo()
  3071. '
  3072. '  The parent is the container the object is in, or zero.  (The parent
  3073. '  is zero if it is in a room.) --> par()
  3074. '
  3075. '  The "relationship" to the parent is given by:
  3076. '    MODE  DESCRIPTION
  3077. '      0 - inside
  3078. '      1 - wrapped by
  3079. '      2 - on top of
  3080. '      3 - underneath (only for objects under tables, etc., NOT for
  3081. '          objects stacked on top of each other---use 2 for that)
  3082. '  --> rel()
  3083. '
  3084. '  (The maximum number of relationships is stored in the mrel variable.
  3085. '  This is set by the second number in the first DATA statement, below.
  3086. '  The relationship is also referred to as "mode" elsewhere in the program.)
  3087. '
  3088. '  Size --> size().  The size of the object and everything
  3089. '     on top of and wrapped by (relations 1 and 2) the object --> totb()
  3090. '     The total bulk contained in relation rel to object n. --> bulk(rel,n)
  3091. '  Weight --> ?.  You give the weight of the object by itself, but the only
  3092. '     number which is stored is the total weight of the object and everything
  3093. '     inside it and on top of it.  This is stored in --> totw()
  3094. '        (The weight of the object by itself is implicit in the totw() array,
  3095. '     so it is not stored anywhere.)
  3096. '  Inopening, wrapopening, onopening, underopening --> opening(rel,obj).
  3097. '     where rel varies from 0 to 3.  This is how big an object can
  3098. '     fit in, wrapped by, on top of, and underneath an object.  The
  3099. '     "onopening" is usually equal to the surfacecapacity, below.
  3100. '  Containcapacity, wrapcapacity, surfacecapacity, undercapacity -->
  3101. '     cap(rel,obj), where rel varies from 0 to 3.  This is how much stuff
  3102. '     total can fit in relation to the object in these ways.
  3103. '  Containopaque, wrapopaque, surfaceopaque, underopaque --> opaque(rel,obj).
  3104. '     This determines whether or not objects inside, wrapped by, on top of,
  3105. '     or underneath an object are not visible.
  3106. '
  3107. '  Examples:
  3108. '     A bottle might have inopening 1 (narrow opening) but containcapacity
  3109. '  3 (so it can contain 3 objects of size 1).  It would be transparent,
  3110. '  i.e. containopaque = 0.
  3111. '     A purse, on the other hand, might have inopening 4, capacity 6,
  3112. '  and containopaque = 1 (opaque unless the purse is open).
  3113. '     A rug might have wrapcapacity 10, but surfacecapacity 30 (you can
  3114. '  wrap about a third of what you can stuff on top of it lying flat.)
  3115. '     A table might have surfacecapacity 30 and undercapacity 30
  3116. '  (you can stuff as much stuff on it as underneath it).  However, a book
  3117. '  might have surfacecapacity 3, so a table would not fit on the book,
  3118. '  but you could certainly put the book under the table.
  3119. '  
  3120. '  (Size, weight, opening, capacity are in arbitrary units you can devise.
  3121. '  My convention is that most ordinary objects have a size of at least
  3122. '  2, so that really small objects can be distinguished from them by having
  3123. '  a size of 1.)
  3124. '
  3125. '  Holdwater? --> holdwater().
  3126. '  The codes are as follows:
  3127. '     0 - cannot hold water
  3128. '     1 - can hold water
  3129. '     2 - is water
  3130. '  ALL OBJECTS WHICH HOLD WATER MUST BE FOLLOWED BY their own personal
  3131. '  water object (i.e. holdwater() = 2).  This object is resized
  3132. '  as water is added to and removed from the container.
  3133. '  Currently, the program allows an object to hold either water or objects,
  3134. '  but not both at the same time.  (In a revision that can handle
  3135. '  "wetness" this restriction could be lifted.  I *have* thought out
  3136. '  algorithms for handling wetness; it would require major
  3137. '  revisions of almost every subprogram, so I decided to
  3138. '  release this "dry" version of AmigaVenture for those of you who
  3139. '  do not require wetness in your adventures.  If you are interested
  3140. '  in adding such code (remember, you have to handle evaporation, weight,
  3141. '  etc., without slowing down the program too much) please email me (USENET)
  3142. '  at mitsu@well.UUCP through July 1987, and at harvard!mitsu (I think)
  3143. '  from August 1987, and I'll mail you my ideas for how to go about
  3144. '  implementing it within AmigaVenture.)
  3145. '
  3146. '  Closed? --> closed()
  3147. '  Locked? --> locked()
  3148. '
  3149. '  Folded? --> folded()
  3150. '  Foldable? --> foldable()
  3151. '  (Using the following codes:
  3152. '     0 - not foldable
  3153. '     1 - rolled up/rollable
  3154. '     2 - folded up/foldable
  3155. '     3 - tied up/tieable)
  3156. '
  3157. '  Worn? --> worn()
  3158. '  Wearable? --> wearable()
  3159. '  (Using the following codes:
  3160. '     0 - not wearable
  3161. '     1 - on hand
  3162. '     2 - on head, neck, ears
  3163. '     4 - on torso (backpacks, jackets, shirts)
  3164. '     8 - around waist (belts)
  3165. '     16 - on legs)
  3166. '
  3167. '  Soft? --> soft() is 1 for a chair or sofa type soft, and 2 for a bed
  3168. '  soft. An object can be used as a piece of furniture if its surface is
  3169. '  large enough.
  3170. '
  3171. '  Food? --> food() Whether or not it is edible, and how nutritious.
  3172. '     Arbitrary units.  Currently the food just disappears when eaten,
  3173. '     and has no effect.  Modify the Eat: routine for your personal system.
  3174. '
  3175. '  Liquid? --> liquid() Whether or not the object is a liquid.  All such
  3176. '     objects MUST be preceded by an object that can "holdwater".
  3177. '     Similarly, all objects that "holdwater" must be followed by a
  3178. '     liquid.  Currently the only liquid is water.
  3179. '
  3180. '  Immobile? --> immobile() objects cannot be moved, removed, etc. (like
  3181. '  doors, etc.)  In future revisions, this might contain a value
  3182. '  describing the degree of immobility (from 0-free, 1-nails/hinges,
  3183. '  2-mortar, 3-plasteel, etc.)  Currently, if an "immobile" object
  3184. '  that has *no* interior or surface (no capacity in any of the four
  3185. '  relations) and is lying free in a room (no parent), it is NOT linked into
  3186. '  the list of objects in that room, and will NOT appear in the description
  3187. '  of objects in the room (i.e., will not appear in the Here, you see:
  3188. '  list.)  The object should be described in the textual description of the
  3189. '  room.  Good uses for this would be for stairways, bookshelves, and the
  3190. '  like.  You don't want such things in the "Here, you see:" list, but
  3191. '  if the player has a reason to refer to them, you don't want the
  3192. '  program to say "I see no stairwell here." or worse "I don't know
  3193. '  what you mean by 'stairwell.'"
  3194. '
  3195. '  Please note the special importance of object 1, as described below.
  3196. '
  3197. '  Feel free to add to this list.  If you add to the list, simply
  3198. '  change the Initialize: routine and update the object data statements.
  3199. '  Perhaps someone can come up with an IFF-style format for storing
  3200. '  object descriptions, and people could write adventures that
  3201. '  allowed you to take objects from one adventure to the next.  But
  3202. '  that is a whole different ball of wax.  (How would you Number them,
  3203. '  for example?)
  3204. '
  3205. '  Of course, to save memory, this list and the whole Initialize: routine
  3206. '  should be placed in a separate program and run *before* the program,
  3207. '  and the program could just read in the results from a disk file.  Note
  3208. '  that you must copy the Insert() and Setloc() subprograms to such
  3209. '  an "initialization" program.  This would also be much faster.  However,
  3210. '  while developing an adventure, it is much more handy to have the
  3211. '  object list in the program, so you can "recompile" the object list
  3212. '  immediately as you modify your adventure.  Another neat idea would be
  3213. '  to write an AmigaVenture Object Editor, which could have all sorts
  3214. '  of interesting features (standard object types, etc. so you don't
  3215. '  have to specify all these attributes over and over for each object.)
  3216. '
  3217. '  This list is meant only as a guide to a fairly complete, albeit simple,
  3218. '  system for defining objects and their relationships.  One could imagine
  3219. '  arbitrarily extending this list of attributes to any desired degree
  3220. '  of realism; however, you should consider how much the added
  3221. '  attribute actually adds to the realism and play value of your
  3222. '  adventure versus the effort and program space taken to take care of
  3223. '  all the relationships the such attributes might entail (for example,
  3224. '  wetness).
  3225. '
  3226. '  NOTE TO THE PROGRAMMER:
  3227. '  Objects are kept track of in the following way:
  3228. '  The arrays lo(), par(), first(rel,), last(rel,), left(), and right()
  3229. '  contain information about doubly-linked lists of objects embedded
  3230. '  in a tree structure.
  3231. '
  3232. '  lo(obj) is the room the object is in. (0 if it is in limbo.  Note
  3233. '  the significance of location 1, the player's special location.)
  3234. '
  3235. '  first(rel,obj) holds the first in the list of objects in, wrapped by, on,
  3236. '  or under object "obj", or zero if none.  The "rel" index is 0, 1, 2,
  3237. '  and 3, respectively.
  3238. '
  3239. '  Lfirst(loc) (see Map:) holds the first in the list of objects lying free
  3240. '  in location "loc".
  3241. '
  3242. '  last(rel,obj) holds the last in the list of objects in, wrapped by, on,
  3243. '  or under object "obj", or zero if none.  The "rel" index is the same
  3244. '  as above.
  3245. '
  3246. '  Llast(loc) (see Map:) holds the last in the list of objects lying free
  3247. '  in location "loc".
  3248. '
  3249. '  par(obj) holds the parent of the object (0 if it is lying free)
  3250. '  rel(obj) holds the relation. (0, 1, 2, 3 for in, wrapped, on, under.)
  3251. '  (Ex.:If object 7 is on top of object 3, then par(7) = 3, rel(7) = 2 (on).)
  3252. '  (Ex.:If object 4 is lying free in room 17, then lo(4) = 17, par(4) = 0,
  3253. '       and rel(4) = 0.)
  3254. '
  3255. '  right(obj) holds the next in the list of objects.
  3256. '
  3257. '  left(obj) is the *previous* object in the list.
  3258. '
  3259. '  As below:
  3260. '
  3261. '            Parent (Bag) ---------------------------------\
  3262. '                | (RELATION 0, in)                        | Last
  3263. '                V                                         V
  3264. '            First (Fruit) Right -> (Sandwich) Right -> (Rock) Right -> Zero
  3265. 'Zero <- Left               <- Left             <- Left
  3266. '
  3267. '  The paradigm is the program keeps track of a whole bunch of little
  3268. '  lists of objects.  Each list is either lying free in a room,
  3269. '  or inside, on top of, wrapped by, or underneath another object.
  3270. '  EVERY OBJECT keeps track of the following information about their
  3271. '  list: the parent of the list (0 if lying free), the relation the list
  3272. '  is in to the parent (0, 1, 2, 3 for in, wrapped, on, under), the
  3273. '  location number the list resides in (0 for limbo, 1 for player, 2 ...
  3274. '  for a map location).
  3275. '
  3276. '  The Remove(), Insert(), RemList() and Concat() subprograms handle
  3277. '  the list operations automatically.  They also update the totw(), totb()
  3278. '  and bulk(rel,) arrays.  ALWAYS use these routines to move objects
  3279. '  around, NEVER directly modify the list arrays yourself, to ensure that
  3280. '  all the lists and arrays remain consistent.  It took a long time to
  3281. '  debug these arrays, and a lot of redundant information is kept track
  3282. '  of for program speed, so take advantage of these routines.  Descriptions
  3283. '  of the routines are found near their implementations (after Lists:).
  3284.  
  3285. ' Maximum number of objects (can be changed at will)
  3286. DATA 100
  3287.  
  3288. ' The largest relationship number (in == 0, on, under, wrap == 3)
  3289. DATA 3
  3290.  
  3291. ' The largest number of water containers (can be changed at will)
  3292. DATA 10
  3293.  
  3294. '  NOTE: Object number 1 is reserved for containing all the objects the
  3295. '  player is carrying.  This object is placed in location 1, and may not
  3296. '  be moved.  Also, no other object should be placed in location 1.
  3297. '
  3298. '  Items being carried by the player should be related to object 1 in
  3299. '  mode 1 (normally "wrapped by").  Items being *worn* by the player should
  3300. '  be related to object 1 in mode 0.
  3301. '
  3302. '  FOR OBJECT NUMBER 1 ONLY:
  3303. '
  3304. '       RELATION   DESCRIPTION
  3305. '       --------   -----------
  3306. '          0       Objects being worn
  3307. '          1       Objects being carried
  3308. '
  3309. ' Objects carried thus must start with 1,1,1,...
  3310. ' Objects worn must start with 1,0,1,...
  3311.  
  3312. ObjList:
  3313. DATA 1,,you,,
  3314. DATA 1,0,0, 0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,,0
  3315. ' The program currently assumes the variable "lamp" is the object
  3316. ' number of the lamp, and the flag number "lampon" determines whether
  3317. ' it is on or off.  See Flags:, Calc:CheckLight(), and also TurnOn:
  3318. ' and TurnOff:
  3319. DATA 2,a brass,lamp,brass,"The lamp is worn from use but still serviceable.
  3320. DATA 1,1,1, 5,5, 0,0,2,0, 0,0,2,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0
  3321. DATA 3,a,sandwich,ham and cheese,"It's a ham and cheese sandwich.
  3322. DATA 1,7,0, 2,2, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,1,0
  3323. DATA 5,a small,purse,satin,"The purse is made of satin.
  3324. DATA 4,0,0, 3,2, 6,0,2,0, 6,0,2,0, 1,1,0,0, 0,1,0,0,0,0, 0,0,0,0,0
  3325. DATA 6,a pearl,earring,pearl,"The earring is made of three exquisite pearls.
  3326. DATA 4,5,0, 1,1, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,2,0,0,0
  3327. DATA 7,a brown,bag,small paper,"It's just a small paper lunch sack.
  3328. DATA 1,1,1, 3,2, 4,2,4,0, 4,2,4,0, 1,1,0,0, 1,1,0,2,0,0, 0,0,0,0,0
  3329. DATA 8,a diamond,earring,diamond,"The earring is made of two precious diamonds.
  3330. DATA 3,0,0, 1,1, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,2,0,0,0
  3331. DATA 10,a glass,bottle,glass,"It's an old Coke bottle.
  3332. DATA 3,0,0, 1,1, 1,0,1,0, 2,0,1,0, 0,0,0,0, 0,1,0,0,0,1, 0,0,0,0,0
  3333. DATA 11,some,water,"",""
  3334. DATA 3,10,0, 2,2, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,2, 0,0,0,0,0
  3335. DATA 12,an elfin,hat,elfin,"It's made of old, dirty green felt.
  3336. DATA 1,1,0, 2,2, 3,1,2,0, 3,1,2,0, 0,1,0,1, 0,0,0,2,0,0, 2,2,1,0,0
  3337. DATA 13,a small Oriental,rug,small Oriental,"The rug is well-worn from use.
  3338. DATA 4,0,0, 10,8, 0,7,20,0, 0,7,20,0, 0,0,0,1, 0,0,0,1,0,0, 0,0,1,0,0
  3339. DATA 14,a large,backpack,frame,"The label says 'REI.'
  3340. DATA 3,0,0, 10,10, 10,0,5,0, 20,0,5,0, 1,0,0,0, 1,1,0,0,0,0, 0,4,1,0,0
  3341. DATA 15,a long,rope,long,"The rope is made from hemp.
  3342. DATA 4,14,0, 4,3, 0,0,10,0, 0,0,10,0, 0,0,0,0, 0,0,0,0,0,0, 0,8,0,0,0
  3343. DATA 16,a,table,wooden,"The table is simply constructed from wood.
  3344. DATA 4,0,0, 70,50, 0,0,15,20, 0,0,20,20, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0
  3345. DATA 17,some steel,brackets,steel,"The brackets are heavy-duty and appear good as new.
  3346. DATA 4,0,0, 10,10, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,1
  3347. DATA 18,a spiral,staircase,spiral,"The staircase is somewhat crumbling, but still quite useable.
  3348. DATA 4,0,0, 0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,1
  3349. DATA 19,a marble,fountain,marble,"The fountain is made of striated marble.
  3350. DATA 8,0,0, 200,300, 100,0,0,0, 100,0,0,0, 0,0,0,0, 0,0,0,0,0,1, 0,0,0,0,1
  3351. DATA 20,some,water,"",""
  3352. DATA 8,19,0, 100,100, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,2, 0,0,0,0,0
  3353. ' (End marker)
  3354. DATA 0
  3355.  
  3356. Nouns:
  3357. '  The list of nouns goes simply
  3358. '
  3359. '  data  noun,object 1,object 2, . . .,0
  3360. '
  3361. '  for each noun.  The list of objects are all the objects the noun
  3362. '  could possibly refer to.  
  3363. '
  3364. '  The "noun" could also be an adjective.  The interpreter will
  3365. '  ask for futher clarification if there is still unresolved ambiguity.
  3366. '
  3367. '  Negative numbers refer to features or directions or other
  3368. '  abstractions which do not have objects associated with them.
  3369. '
  3370. '  This list must be all single words, no spaces.
  3371. '
  3372.  
  3373. ' Maximum number of nouns, maximum number of homonyms
  3374. DATA 150,300
  3375.  
  3376. DATA the,0,a,0,an,0,those,0,these,0,for,0,is,0,are,0,by,0
  3377.  
  3378. DATA north,-1,0,n,-1,0,northeast,-2,0,ne,-2,0,east,-3,0,e,-3,0
  3379. DATA southeast,-4,0,se,-4,0,south,-5,0,s,-5,0,southwest,-6,0,sw,-6,0
  3380. DATA west,-7,0,w,-7,0,northwest,-8,0,nw,-8,0
  3381. DATA up,-9,0,u,-9,0,down,-10,0,d,-10,0
  3382. DATA upstairs,-9,0,downstairs,-10,0,ascend,-9,0,descend,-10,0
  3383.  
  3384. ' Nouns from -11 to -19 are reserved as special words for use by the
  3385. ' interpreter.  Do not change them without changing the interpreter also
  3386. DATA all,-11,0,everything,-11,0,it,-12,0,him,-12,0,her,-12,0,them,-13,0
  3387. DATA that,-14,0,that's,-14,0,that're,-14,0
  3388. DATA what,-15,0,what's,-15,0,what're,-15,0
  3389.  
  3390. DATA i,-20,0,me,-20,0,myself,-20,0,self,-20,0,my,-20,0
  3391. DATA you,-21,0,yourself,-21,0,your,-21,0
  3392. DATA game,-22,0
  3393.  
  3394. DATA lamp,2,0,brass,2,0
  3395. DATA ham,3,0,cheese,3,0,sandwich,3,0
  3396. DATA small,5,7,0,satin,5,0,purse,5,0
  3397. DATA pearl,6,0,earring,6,8,0
  3398. DATA brown,7,0,paper,7,0,bag,7,0
  3399. DATA diamond,8,0
  3400. DATA glass,10,0,bottle,10,0,Coke,10,0
  3401. DATA water,11,20,0
  3402. DATA elfin,12,0,felt,12,0,old,12,0,dirty,12,0,green,12,0,hat,12,0
  3403. DATA small,13,0,Oriental,13,0,well-worn,13,0,worn,13,0,rug,13,0
  3404. DATA large,14,0,frame,14,0,REI,14,0,backpack,14,0,pack,14,0
  3405. DATA long,15,0,hemp,15,0,rope,15,0
  3406. DATA wooden,16,0,table,16,0,wood,16,0
  3407. DATA steel,17,0,brackets,17,0
  3408. DATA stairs,18,0,staircase,18,0,spiral,18,0,stairway,18,0
  3409. DATA marble,19,0,fountain,19,0
  3410. ' (End marker)
  3411. DATA "",0
  3412.  
  3413. ' Abstract words like directions, etc., (any noun associated
  3414. ' with no concrete moveable Object).
  3415. ' The format is:
  3416. '    DATA code,word,code,word,etc.  (this is the same as
  3417. ' the Objects format, but with only one descriptor).
  3418.  
  3419. abstract:
  3420. ' Maximum number of abstract nouns (changeable, of course)
  3421. DATA 50
  3422.  
  3423. DATA 1,north,2,northeast,3,east,4,southeast,5,south
  3424. DATA 6,southwest,7,west,8,northwest,9,up,10,down
  3425. DATA 11,everything
  3426. DATA 13,water
  3427. DATA 20,yourself,21,me
  3428. DATA 22,the game
  3429.  
  3430.  
  3431. ' (End marker)
  3432. DATA 0,""
  3433.  
  3434. fold:
  3435. DATA 3
  3436. DATA rolled up,folded up,tied up
  3437.  
  3438. ' (End marker)
  3439. DATA ""
  3440.  
  3441. Verbs:
  3442. '
  3443. '  The list of verbs goes:
  3444. '
  3445. '  data verb,number,verb,number, . . .
  3446. '
  3447. '  The "number" refers to the number of the verb, which must correspond
  3448. '  to the number used by DoCommand when it goes to the appropriate
  3449. '  command in its ON GOTO statement.  See DoCommand.
  3450. '
  3451. '  Verbs of three words in length are placed first,
  3452. '  followed by a data "",0.  Then verbs of two words, followed
  3453. '  by a data "",0.  Finally all single-word verbs.
  3454. '
  3455. '  (an unlimited number of verbs are possible).
  3456. '
  3457. '   Please reserve verb numbers 1-49 for kernal verbs, common to
  3458. '  all adventures.  This allows upgrades of the adventure kernal
  3459. '  to be separated from adventure-specific commands.  If you update
  3460. '  the kernal, please use verbs 1-49; use verbs 50 and up for
  3461. '  magic words, etc. which would not be used in another adventure.
  3462. '  This allows other people to be able to take advantage of your
  3463. '  kernal upgrades without having to wade through adventure-specific
  3464. '  code.  Currently verbs 1-29 are being used.
  3465.  
  3466. '*** Three-word verbs
  3467. DATA let go of,3,get rid of,3,do it again,24,do it over,24
  3468. DATA i give up,32,I give up,32
  3469. DATA "",0
  3470.  
  3471. '*** Two-word verbs
  3472. DATA look at,5,look around,1,pick up,2,get out,2,take out,2,put down,3
  3473. DATA get me,3
  3474. DATA turn on,12,turn off,13,save game,17,load game,18
  3475. DATA put on,19,take off,20,wrap up,21,fold up,21,tie up,21,roll up,21
  3476. DATA start over,23,repeat last,24,do again,24,do over,24,over again,24
  3477. DATA pour out,25,fill up,26,eat up,27,gobble up,27
  3478. DATA sit down,29,stand up,30,get up,30,lie down,31
  3479. DATA quit game,32,give up,32,end game,32,drink all,33,drink up,33,slurp up,33
  3480. DATA "",0
  3481.  
  3482. '*** One-word verbs
  3483. DATA look,1,see,1,l,1
  3484. DATA get,2,take,2
  3485. DATA drop,3,release,3
  3486. DATA inventory,4,i,4
  3487. DATA examine,5,read,5
  3488. DATA go,6,walk,6,run,6,hop,6,skip,6,jump,6
  3489. DATA put,7,place,7
  3490. DATA open,8,close,9,lock,10,unlock,11
  3491. DATA activate,12,deactivate,13
  3492. DATA wordy,14,verbose,14,brief,15,superbrief,16
  3493. DATA save,17,load,18,restore,18,record,17
  3494. DATA wear,19,don,19
  3495. DATA wrap,21,fasten,21,unwrap,22,restart,23
  3496. DATA again,24,repeat,24
  3497. DATA empty,25,pour,25,fill,26
  3498. DATA eat,27,munch,27,consume,27,gobble,27,drink,28,quaff,28,slurp,28
  3499. DATA sit,29,stand,30,lie,31
  3500. DATA quit,32
  3501.  
  3502. ' (End marker)
  3503. DATA "",0
  3504.  
  3505. ' The preposition codes are 1 more than the relationship codes
  3506. ' for object lists (see Objects: 0 = in, 1 = wrapped by, et cetera).
  3507. Prepositions:
  3508.  
  3509. DATA in,1,into,1,inside,1,wrapped,2,lying,3,on,3,onto,3,under,4,underneath,4
  3510. DATA to,5,with,6,from,7,and,8,then,8,but,9,except,9,not,9
  3511.  
  3512. ' (End marker)
  3513. DATA "",0
  3514.  
  3515. Prepnames: 'Starting with preposition zero (null)
  3516.  
  3517. DATA . . .,inside,wrapped by,on,underneath,to,with
  3518.  
  3519. ' (End marker)
  3520. DATA ""
  3521.  
  3522.  
  3523.